From 531cc28876212b1f01272892f07329c7011b95ca Mon Sep 17 00:00:00 2001
From: Ryan Trinkle <ryan.trinkle@gmail.com>
Date: Sun, 15 Sep 2019 19:29:45 -0400
Subject: [PATCH 01/34] WIP

---
 reflex.cabal                          |   1 +
 src/Data/TagMap.hs                    |  31 +++++
 src/Data/Unique/Tag/Local.hs          |  11 ++
 src/Data/Unique/Tag/Local/Internal.hs |  51 +++++++
 src/Reflex/FanTag.hs                  |  23 ++++
 src/Reflex/PerformEvent/Base.hs       |  28 +++-
 src/Reflex/Requester/Base.hs          | 184 +++++++++++++++++++++-----
 src/Reflex/Requester/Class.hs         |   2 +-
 8 files changed, 297 insertions(+), 34 deletions(-)
 create mode 100644 src/Data/TagMap.hs
 create mode 100644 src/Data/Unique/Tag/Local.hs
 create mode 100644 src/Data/Unique/Tag/Local/Internal.hs
 create mode 100644 src/Reflex/FanTag.hs

diff --git a/reflex.cabal b/reflex.cabal
index a0984333..62a87752 100644
--- a/reflex.cabal
+++ b/reflex.cabal
@@ -57,6 +57,7 @@ library
     containers >= 0.6 && < 0.7,
     data-default >= 0.5 && < 0.8,
     dependent-map >= 0.3 && < 0.4,
+    dlist == 0.8.*,
     exception-transformers == 0.4.*,
     profunctors >= 5.3 && < 5.5,
     lens >= 4.7 && < 5,
diff --git a/src/Data/TagMap.hs b/src/Data/TagMap.hs
new file mode 100644
index 00000000..6ed2a261
--- /dev/null
+++ b/src/Data/TagMap.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Data.TagMap
+  ( TagMap
+  , unTagMap
+  , fromDMap
+  , toDMap
+  , insert
+  ) where
+
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+import Data.Dependent.Map (DMap)
+import qualified Data.Dependent.Map as DMap
+import Data.Dependent.Sum (DSum (..))
+import Data.Unique.Tag.Local
+
+import GHC.Exts (Any)
+import Unsafe.Coerce
+
+-- | Like DMap, but with 'Data.Unique.Tag.Tag' as the keys.  Implemented using 'Data.IntMap.IntMap' under the hood.
+newtype TagMap x (v :: k -> *) = TagMap { unTagMap :: IntMap Any }
+
+fromDMap :: forall k x (v :: k -> *). DMap (Tag x) v -> TagMap x v
+fromDMap = TagMap . IntMap.fromDistinctAscList . fmap (\((k :: Tag x (a :: k)) :=> v) -> (tagId k, (unsafeCoerce :: v a -> Any) v)) . DMap.toAscList
+
+toDMap :: forall x v. TagMap x v -> DMap (Tag x) v
+toDMap = DMap.fromDistinctAscList . fmap (\(k, v) -> (unsafeTagFromId k :=> (unsafeCoerce :: Any -> v a) v)) . IntMap.toAscList . unTagMap
+
+insert :: forall x a v. Tag x a -> v a -> TagMap x v -> TagMap x v
+insert k v = TagMap . IntMap.insert (tagId k) ((unsafeCoerce :: v a -> Any) v) . unTagMap
diff --git a/src/Data/Unique/Tag/Local.hs b/src/Data/Unique/Tag/Local.hs
new file mode 100644
index 00000000..4b2ab85d
--- /dev/null
+++ b/src/Data/Unique/Tag/Local.hs
@@ -0,0 +1,11 @@
+module Data.Unique.Tag.Local
+  ( Tag
+  , TagGen (..)
+  , TagGenT
+  , tagId
+  , unsafeTagFromId
+  , runTagGenT
+  , mapTagGenT
+  ) where
+
+import Data.Unique.Tag.Local.Internal
diff --git a/src/Data/Unique/Tag/Local/Internal.hs b/src/Data/Unique/Tag/Local/Internal.hs
new file mode 100644
index 00000000..d7e68e7e
--- /dev/null
+++ b/src/Data/Unique/Tag/Local/Internal.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Data.Unique.Tag.Local.Internal where
+
+import Control.Monad.Exception
+import Control.Monad.Primitive
+import Control.Monad.Reader
+import Data.Primitive.MutVar
+
+newtype Tag x a = Tag Int
+
+tagId :: Tag x a -> Int
+tagId (Tag n) = n
+
+-- | WARNING: If you construct a tag with the wrong type, it will result in
+-- incorrect unsafeCoerce applications, which can segfault or cause arbitrary
+-- other damage to your program
+unsafeTagFromId :: Int -> Tag x a
+unsafeTagFromId n = Tag n
+
+class TagGen m where
+  type TagScope m :: *
+  -- | Note: this will throw an exception if its internal counter would wrap around
+  mkTag :: m (Tag (TagScope m) a)
+
+newtype TagGenT (s :: *) m a = TagGenT { unTagGenT :: ReaderT (MutVar (PrimState m) Int) m a }
+  deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException)
+
+instance MonadTrans (TagGenT s) where
+  lift = TagGenT . lift
+
+data TagGenTScope (ps :: *) (s :: *)
+
+instance PrimMonad m => TagGen (TagGenT s m) where
+  type TagScope (TagGenT s m) = s
+  mkTag = TagGenT $ ReaderT $ \r -> do
+    n <- atomicModifyMutVar' r $ \x -> (succ x, x)
+    pure $ Tag n
+
+runTagGenT :: forall m a. PrimMonad m => (forall s. TagGenT s m a) -> m a
+runTagGenT (TagGenT a :: TagGenT (TagGenTScope (PrimState m) ()) m a) = do
+  r <- newMutVar minBound
+  runReaderT a r
+
+mapTagGenT :: PrimState m ~ PrimState n => (m a -> n b) -> TagGenT s m a -> TagGenT s n b
+mapTagGenT f (TagGenT a) = TagGenT $ mapReaderT f a
diff --git a/src/Reflex/FanTag.hs b/src/Reflex/FanTag.hs
new file mode 100644
index 00000000..b94eea67
--- /dev/null
+++ b/src/Reflex/FanTag.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Reflex.FanTag
+  ( EventSelectorTag
+  , unEventSelectorTag
+  , fanTag
+  , selectTag
+  ) where
+
+import Data.Unique.Tag.Local
+import Data.TagMap
+import Reflex.Class
+
+import GHC.Exts (Any)
+import Unsafe.Coerce
+
+newtype EventSelectorTag t x (v :: k -> *) = EventSelectorTag { unEventSelectorTag :: EventSelectorInt t Any }
+
+fanTag :: Reflex t => Event t (TagMap x v) -> EventSelectorTag t x v
+fanTag = EventSelectorTag . fanInt . fmapCheap unTagMap
+
+selectTag :: forall t x v a. Reflex t => EventSelectorTag t x v -> Tag x a -> Event t (v a)
+selectTag (EventSelectorTag s) = fmapCheap (unsafeCoerce :: Any -> v a) . selectInt s . tagId
diff --git a/src/Reflex/PerformEvent/Base.hs b/src/Reflex/PerformEvent/Base.hs
index f502b622..4575a454 100644
--- a/src/Reflex/PerformEvent/Base.hs
+++ b/src/Reflex/PerformEvent/Base.hs
@@ -68,13 +68,37 @@ instance (PrimMonad (HostFrame t), ReflexHost t) => PrimMonad (PerformEventT t m
   type PrimState (PerformEventT t m) = PrimState (HostFrame t)
   primitive = PerformEventT . lift . primitive
 
-instance (ReflexHost t, Ref m ~ Ref IO) => PerformEvent t (PerformEventT t m) where
+instance (ReflexHost t, Ref m ~ Ref IO, PrimMonad (HostFrame t)) => PerformEvent t (PerformEventT t m) where
   type Performable (PerformEventT t m) = HostFrame t
   {-# INLINABLE performEvent_ #-}
   performEvent_ = PerformEventT . requesting_
   {-# INLINABLE performEvent #-}
   performEvent = PerformEventT . requestingIdentity
 
+-- | An Adjustable instance where "adjusting" just runs the new thing - nothing is done with the old thing
+newtype NullAdjustable t m a = NullAdjustable { unNullAdjustable :: m a }
+  deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException)
+
+instance PrimMonad m => PrimMonad (NullAdjustable t m) where
+  type PrimState (NullAdjustable t m) = PrimState m
+
+instance Adjustable t (PerformEvent t m) where
+  runWithReplace a0 a' = PerformEventT $ do
+    runWithReplace (unPerformEventT a0) a'
+
+{-
+instance Adjustable t (NullAdjustable t m) where
+  runWithReplace a0 a' = NullAdjustable $ do
+    result0 <- lift a0
+    result' <- requestingIdentity a'
+    return (result0, result')
+  traverseDMapWithKeyWithAdjust = defaultAdjustBase traversePatchDMapWithKey
+  traverseDMapWithKeyWithAdjustWithMove = defaultAdjustBase traversePatchDMapWithMoveWithKey
+-}
+{-
+  traverseIntMapWithKeyWithAdjust = defaultAdjustIntBase traverseIntMapPatchWithKey
+-}
+
 instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT t m) where
   runWithReplace outerA0 outerA' = PerformEventT $ runWithReplaceRequesterTWith f (coerce outerA0) (coerceEvent outerA')
     where f :: HostFrame t a -> Event t (HostFrame t b) -> RequesterT t (HostFrame t) Identity (HostFrame t) (a, Event t b)
@@ -82,9 +106,11 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT
             result0 <- lift a0
             result' <- requestingIdentity a'
             return (result0, result')
+            {-
   traverseIntMapWithKeyWithAdjust f outerDm0 outerDm' = PerformEventT $ traverseIntMapWithKeyWithAdjustRequesterTWith (defaultAdjustIntBase traverseIntMapPatchWithKey) patchIntMapNewElementsMap mergeIntIncremental (\k v -> unPerformEventT $ f k v) (coerce outerDm0) (coerceEvent outerDm')
   traverseDMapWithKeyWithAdjust f outerDm0 outerDm' = PerformEventT $ traverseDMapWithKeyWithAdjustRequesterTWith (defaultAdjustBase traversePatchDMapWithKey) mapPatchDMap weakenPatchDMapWith patchMapNewElementsMap mergeMapIncremental (\k v -> unPerformEventT $ f k v) (coerce outerDm0) (coerceEvent outerDm')
   traverseDMapWithKeyWithAdjustWithMove f outerDm0 outerDm' = PerformEventT $ traverseDMapWithKeyWithAdjustRequesterTWith (defaultAdjustBase traversePatchDMapWithMoveWithKey) mapPatchDMapWithMove weakenPatchDMapWithMoveWith patchMapWithMoveNewElementsMap mergeMapIncrementalWithMove (\k v -> unPerformEventT $ f k v) (coerce outerDm0) (coerceEvent outerDm')
+-}
 
 defaultAdjustBase :: forall t v v2 k' p. (Monad (HostFrame t), PrimMonad (HostFrame t), Reflex t)
   => ((forall a. k' a -> v a -> HostFrame t (v2 a)) -> p k' v -> HostFrame t (p k' v2))
diff --git a/src/Reflex/Requester/Base.hs b/src/Reflex/Requester/Base.hs
index 95440eb2..91a3eb16 100644
--- a/src/Reflex/Requester/Base.hs
+++ b/src/Reflex/Requester/Base.hs
@@ -15,26 +15,24 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE InstanceSigs #-}
 #ifdef USE_REFLEX_OPTIMIZER
 {-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
 #endif
 module Reflex.Requester.Base
   ( RequesterT (..)
   , runRequesterT
-  , withRequesterT
-  , runWithReplaceRequesterTWith
-  , traverseIntMapWithKeyWithAdjustRequesterTWith
-  , traverseDMapWithKeyWithAdjustRequesterTWith
-  , RequesterData
-  , RequesterDataKey
-  , traverseRequesterData
-  , forRequesterData
-  , requesterDataToList
-  , singletonRequesterData
-  , matchResponsesWithRequests
-  , multiEntry
-  , unMultiEntry
-  , requesting'
+--  , withRequesterT
+--  , RequesterData
+--  , RequesterDataKey
+--  , traverseRequesterData
+--  , forRequesterData
+--  , requesterDataToList
+--  , singletonRequesterData
+--  , matchResponsesWithRequests
+--  , multiEntry
+--  , unMultiEntry
+--  , requesting'
   ) where
 
 import Reflex.Class
@@ -45,6 +43,8 @@ import Reflex.PerformEvent.Class
 import Reflex.PostBuild.Class
 import Reflex.Requester.Class
 import Reflex.TriggerEvent.Class
+import Reflex.EventWriter.Base
+import Reflex.EventWriter.Class
 
 import Control.Applicative (liftA2)
 import Control.Monad.Exception
@@ -68,8 +68,144 @@ import Data.Proxy
 import qualified Data.Semigroup as S
 import Data.Some (Some(Some))
 import Data.Type.Equality
-import Data.Unique.Tag
+import Data.Sequence (Seq)
+import qualified Data.Sequence as Seq
+import Data.TagMap
+import Reflex.FanTag
+import Data.Unique.Tag.Local
+import qualified Data.Unique.Tag as Global
+import Data.GADT.Compare
+
+data RequestData m request = forall s. RequestData !(Global.Tag (PrimState m) s) !(Seq (RequestEnvelope s request))
+data ResponseData m response = forall s. ResponseData !(Global.Tag (PrimState m) s) !(TagMap s response)
+
+runRequesterT :: forall t request response m a
+  .  ( Reflex t
+     , PrimMonad m
+     , MonadFix m
+     )
+  => RequesterT t request response m a
+  -> Event t (ResponseData m response)
+  -> m (a, Event t (RequestData m request))
+runRequesterT (RequesterT a) wrappedResponses = withRequesterInternalT $ \(requests :: Event t (Seq (RequestEnvelope s request))) -> do
+  t :: Global.Tag (PrimState m) s <- lift Global.newTag
+  result <- a
+  let responses = fforMaybe wrappedResponses $ \(ResponseData s m) -> case s `geq` t of
+        Nothing -> Nothing --TODO: Warn somehow
+        Just Refl -> Just m
+  pure (responses, (result, fmap (RequestData t) requests))
+
+instance MonadTrans (RequesterInternalT s t request response) where
+  lift = RequesterInternalT . lift . lift . lift
+
+instance MonadTrans (RequesterT t request response) where
+  lift a = RequesterT $ RequesterInternalT $ lift $ lift $ lift a
+
+-- | Run a 'RequesterT' action.  The resulting 'Event' will fire whenever
+-- requests are made, and responses should be provided in the input 'Event'.
+-- The 'Tag' keys will be used to return the responses to the same place the
+-- requests were issued.
+withRequesterInternalT :: (Reflex t, PrimMonad m, MonadFix m)
+              => (forall s. Event t (Seq (RequestEnvelope s request)) -> RequesterInternalT s t request response m (Event t (TagMap s response), a))
+              -> m a
+withRequesterInternalT f = runTagGenT $ do
+  rec let RequesterInternalT a = f requests
+      ((responses, result), requests) <- runEventWriterT $ runReaderT a (fanTag responses)
+  pure result
+
+data RequestEnvelope s request = forall a. RequestEnvelope {-# UNPACK #-} !(Maybe (Tag s a)) !(request a)
+
+newtype RequesterT t (request :: * -> *) (response :: * -> *) m a = RequesterT { unRequesterT :: forall s. RequesterInternalT s t request response m a }
+
+instance Functor m => Functor (RequesterT t request response m) where
+  fmap f (RequesterT x) = RequesterT $ fmap f x
+
+instance Monad m => Applicative (RequesterT t request response m) where
+  pure x = RequesterT $ pure x
+  RequesterT f <*> RequesterT x = RequesterT $ f <*> x
+  liftA2 f (RequesterT a) (RequesterT b) = RequesterT $ liftA2 f a b
+  RequesterT f <* RequesterT x = RequesterT $ f <* x
+  RequesterT f *> RequesterT x = RequesterT $ f *> x
+
+instance Monad m => Monad (RequesterT t request response m) where
+  return = pure
+  RequesterT mx >>= f = RequesterT $ mx >>= \x -> case f x of
+    RequesterT y -> y
+
+instance MonadFix m => MonadFix (RequesterT t request response m) where
+  mfix f = RequesterT $ mfix $ \x -> case f x of
+    RequesterT a -> a
+
+instance MonadIO m => MonadIO (RequesterT t request respnose m) where
+  liftIO a = RequesterT $ liftIO a
+
+instance MonadException m => MonadException (RequesterT t request respnose m) where
+  throw e = RequesterT $ throw e
+
+newtype RequesterInternalT s t request response m a = RequesterInternalT { unRequesterInternalT :: ReaderT (EventSelectorTag t s response) (EventWriterT t (Seq (RequestEnvelope s request)) (TagGenT s m)) a }
+  deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException)
+
+instance MonadSample t m => MonadSample t (RequesterT t request response m)
+instance MonadHold t m => MonadHold t (RequesterT t request response m)
+instance PostBuild t m => PostBuild t (RequesterT t request response m)
+instance TriggerEvent t m => TriggerEvent t (RequesterT t request response m)
+
+instance PrimMonad m => PrimMonad (RequesterT t request response m) where
+  type PrimState (RequesterT t request response m) = PrimState m
+  primitive = lift . primitive
+
+-- TODO: Monoid and Semigroup can likely be derived once StateT has them.
+instance (Monoid a, Monad m) => Monoid (RequesterT t request response m a) where
+  mempty = pure mempty
+  mappend = liftA2 mappend
 
+instance (S.Semigroup a, Monad m) => S.Semigroup (RequesterT t request response m a) where
+  (<>) = liftA2 (S.<>)
+
+instance PerformEvent t m => PerformEvent t (RequesterT t request response m) where
+  type Performable (RequesterT t request response m) = Performable m
+  performEvent_ = lift . performEvent_
+  performEvent = lift . performEvent
+
+instance MonadRef m => MonadRef (RequesterT t request response m) where
+  type Ref (RequesterT t request response m) = Ref m
+  newRef = lift . newRef
+  readRef = lift . readRef
+  writeRef r = lift . writeRef r
+
+instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (RequesterT t request response m) where
+  newEventWithTrigger = lift . newEventWithTrigger
+  newFanEventWithTrigger f = lift $ newFanEventWithTrigger f
+
+instance MonadReader r m => MonadReader r (RequesterT t request response m) where
+  ask = lift ask
+  local f (RequesterT a) = RequesterT $ RequesterInternalT $ mapReaderT (mapEventWriterT $ mapTagGenT $ local f) $ unRequesterInternalT a
+  reader = lift . reader
+
+instance (Reflex t, PrimMonad m) => Requester t (RequesterT t request response m) where
+  type Request (RequesterT t request response m) = request
+  type Response (RequesterT t request response m) = response
+  requesting e = RequesterT $ RequesterInternalT $ do
+    t <- lift $ lift mkTag
+    tellEvent $ fmapCheap (Seq.singleton . RequestEnvelope (Just t)) e
+    s <- ask
+    pure $ selectTag s t
+  requesting_ e = RequesterT $ RequesterInternalT $ do
+    tellEvent $ fmapCheap (Seq.singleton . RequestEnvelope Nothing) e
+
+
+{-# INLINABLE runWithReplaceRequesterTWith #-}
+runWithReplaceRequesterTWith :: forall m t request response a b. (Reflex t, MonadHold t m
+                                                                 , MonadFix m
+                                                                 )
+                             => (forall a' b'. m a' -> Event t (m b') -> RequesterT t request response m (a', Event t b'))
+                             -> RequesterT t request response m a
+                             -> Event t (RequesterT t request response m b)
+                             -> RequesterT t request response m (a, Event t b)
+runWithReplaceRequesterTWith f (RequesterT a0) a' = RequesterT $ do
+  pure undefined
+
+{-
 import GHC.Exts (Any)
 import Unsafe.Coerce
 
@@ -244,23 +380,6 @@ newtype RequesterT t request (response :: * -> *) m a = RequesterT { unRequester
 #endif
            )
 
-deriving instance MonadSample t m => MonadSample t (RequesterT t request response m)
-deriving instance MonadHold t m => MonadHold t (RequesterT t request response m)
-deriving instance PostBuild t m => PostBuild t (RequesterT t request response m)
-deriving instance TriggerEvent t m => TriggerEvent t (RequesterT t request response m)
-
-instance PrimMonad m => PrimMonad (RequesterT t request response m) where
-  type PrimState (RequesterT t request response m) = PrimState m
-  primitive = lift . primitive
-
--- TODO: Monoid and Semigroup can likely be derived once StateT has them.
-instance (Monoid a, Monad m) => Monoid (RequesterT t request response m a) where
-  mempty = pure mempty
-  mappend = liftA2 mappend
-
-instance (S.Semigroup a, Monad m) => S.Semigroup (RequesterT t request response m a) where
-  (<>) = liftA2 (S.<>)
-
 
 -- | Run a 'RequesterT' action.  The resulting 'Event' will fire whenever
 -- requests are made, and responses should be provided in the input 'Event'.
@@ -535,3 +654,4 @@ matchResponsesWithRequests f send recv = do
             ( singletonRequesterData k rsp
             , PatchMap $ Map.singleton n Nothing
             )
+-}
diff --git a/src/Reflex/Requester/Class.hs b/src/Reflex/Requester/Class.hs
index db4ddb99..e05204de 100644
--- a/src/Reflex/Requester/Class.hs
+++ b/src/Reflex/Requester/Class.hs
@@ -40,7 +40,7 @@ class (Reflex t, Monad m) => Requester t m | m -> t where
   requesting :: Event t (Request m a) -> m (Event t (Response m a))
   -- | Emit a request whenever the given 'Event' fires, and ignore all responses.
   requesting_ :: Event t (Request m a) -> m ()
-
+--TODO: Make Requester polykinded, where Request m and Response m both take an argument of the same kind
 
 instance Requester t m => Requester t (ReaderT r m) where
   type Request (ReaderT r m) = Request m

From 44cfdfa621f34fefe8b8fa89d01ef6f5a5149467 Mon Sep 17 00:00:00 2001
From: Ryan Trinkle <ryan.trinkle@gmail.com>
Date: Mon, 16 Sep 2019 22:34:28 -0400
Subject: [PATCH 02/34] More WIP (doesn't build)

---
 src/Data/TagMap.hs                    |   4 +
 src/Data/Unique/Tag/Local.hs          |   6 +-
 src/Data/Unique/Tag/Local/Internal.hs |  46 +-
 src/Reflex/PerformEvent/Base.hs       |  18 +-
 src/Reflex/Requester/Base.hs          | 640 +------------------------
 src/Reflex/Requester/Base/Internal.hs | 661 ++++++++++++++++++++++++++
 6 files changed, 702 insertions(+), 673 deletions(-)
 create mode 100644 src/Reflex/Requester/Base/Internal.hs

diff --git a/src/Data/TagMap.hs b/src/Data/TagMap.hs
index 6ed2a261..06873c69 100644
--- a/src/Data/TagMap.hs
+++ b/src/Data/TagMap.hs
@@ -5,6 +5,7 @@ module Data.TagMap
   , unTagMap
   , fromDMap
   , toDMap
+  , fromList
   , insert
   ) where
 
@@ -29,3 +30,6 @@ toDMap = DMap.fromDistinctAscList . fmap (\(k, v) -> (unsafeTagFromId k :=> (uns
 
 insert :: forall x a v. Tag x a -> v a -> TagMap x v -> TagMap x v
 insert k v = TagMap . IntMap.insert (tagId k) ((unsafeCoerce :: v a -> Any) v) . unTagMap
+
+fromList :: [DSum (Tag x) v] -> TagMap x v
+fromList = TagMap . IntMap.fromList . fmap (\(t :=> v) -> (tagId t, (unsafeCoerce :: v a -> Any) v))
diff --git a/src/Data/Unique/Tag/Local.hs b/src/Data/Unique/Tag/Local.hs
index 4b2ab85d..2e10b8c7 100644
--- a/src/Data/Unique/Tag/Local.hs
+++ b/src/Data/Unique/Tag/Local.hs
@@ -1,11 +1,11 @@
 module Data.Unique.Tag.Local
   ( Tag
   , TagGen (..)
-  , TagGenT
   , tagId
   , unsafeTagFromId
-  , runTagGenT
-  , mapTagGenT
+  , newTag
+  , newTagGen
+  , withTagGen
   ) where
 
 import Data.Unique.Tag.Local.Internal
diff --git a/src/Data/Unique/Tag/Local/Internal.hs b/src/Data/Unique/Tag/Local/Internal.hs
index d7e68e7e..7d4e1550 100644
--- a/src/Data/Unique/Tag/Local/Internal.hs
+++ b/src/Data/Unique/Tag/Local/Internal.hs
@@ -1,3 +1,7 @@
+-- | The type-safety of this module depends on two assumptions:
+-- 1. If the `s` parameters on two `TagGen`s can unify, then they contain the same MutVar
+-- 2. Two Tag values made from the same TagGen never contain the same Int
+
 {-# LANGUAGE EmptyDataDecls #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -11,6 +15,9 @@ import Control.Monad.Exception
 import Control.Monad.Primitive
 import Control.Monad.Reader
 import Data.Primitive.MutVar
+import Data.GADT.Compare
+import Data.Some
+import Unsafe.Coerce
 
 newtype Tag x a = Tag Int
 
@@ -23,29 +30,24 @@ tagId (Tag n) = n
 unsafeTagFromId :: Int -> Tag x a
 unsafeTagFromId n = Tag n
 
-class TagGen m where
-  type TagScope m :: *
-  -- | Note: this will throw an exception if its internal counter would wrap around
-  mkTag :: m (Tag (TagScope m) a)
-
-newtype TagGenT (s :: *) m a = TagGenT { unTagGenT :: ReaderT (MutVar (PrimState m) Int) m a }
-  deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException)
-
-instance MonadTrans (TagGenT s) where
-  lift = TagGenT . lift
+-- We use Int because it is supported by e.g. IntMap
+newtype TagGen ps s = TagGen { unTagGen :: MutVar ps Int }
 
-data TagGenTScope (ps :: *) (s :: *)
+instance GEq (TagGen ps) where
+  TagGen a `geq` TagGen b =
+    if a == b
+    then Nothing
+    else Just $ unsafeCoerce Refl
 
-instance PrimMonad m => TagGen (TagGenT s m) where
-  type TagScope (TagGenT s m) = s
-  mkTag = TagGenT $ ReaderT $ \r -> do
-    n <- atomicModifyMutVar' r $ \x -> (succ x, x)
-    pure $ Tag n
+newTag :: PrimMonad m => TagGen (PrimState m) s -> m (Tag s a)
+newTag (TagGen r) = do
+  n <- atomicModifyMutVar' r $ \x -> (succ x, x)
+  pure $ Tag n
 
-runTagGenT :: forall m a. PrimMonad m => (forall s. TagGenT s m a) -> m a
-runTagGenT (TagGenT a :: TagGenT (TagGenTScope (PrimState m) ()) m a) = do
-  r <- newMutVar minBound
-  runReaderT a r
+newTagGen :: PrimMonad m => m (Some (TagGen (PrimState m)))
+newTagGen = Some . TagGen <$> newMutVar minBound
 
-mapTagGenT :: PrimState m ~ PrimState n => (m a -> n b) -> TagGenT s m a -> TagGenT s n b
-mapTagGenT f (TagGenT a) = TagGenT $ mapReaderT f a
+withTagGen :: PrimMonad m => (forall s. TagGen (PrimState m) s -> m a) -> m a
+withTagGen f = do
+  g <- newTagGen
+  withSome g f
diff --git a/src/Reflex/PerformEvent/Base.hs b/src/Reflex/PerformEvent/Base.hs
index 4575a454..07e3043e 100644
--- a/src/Reflex/PerformEvent/Base.hs
+++ b/src/Reflex/PerformEvent/Base.hs
@@ -28,7 +28,7 @@ import Reflex.Class
 import Reflex.Adjustable.Class
 import Reflex.Host.Class
 import Reflex.PerformEvent.Class
-import Reflex.Requester.Base
+import Reflex.Requester.Base.Internal
 import Reflex.Requester.Class
 
 import Control.Lens
@@ -82,23 +82,23 @@ newtype NullAdjustable t m a = NullAdjustable { unNullAdjustable :: m a }
 instance PrimMonad m => PrimMonad (NullAdjustable t m) where
   type PrimState (NullAdjustable t m) = PrimState m
 
-instance Adjustable t (PerformEvent t m) where
-  runWithReplace a0 a' = PerformEventT $ do
-    runWithReplace (unPerformEventT a0) a'
+instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT t m) where
+  runWithReplace (PerformEventT (RequesterT a0)) a' = PerformEventT $ RequesterT $ do
+    (s, tg) <- RequesterInternalT ask
+    newA <- requestingIdentity $ undefined <$> a'
+    runWithReplace a0 never
 
-{-
 instance Adjustable t (NullAdjustable t m) where
   runWithReplace a0 a' = NullAdjustable $ do
-    result0 <- lift a0
-    result' <- requestingIdentity a'
     return (result0, result')
   traverseDMapWithKeyWithAdjust = defaultAdjustBase traversePatchDMapWithKey
   traverseDMapWithKeyWithAdjustWithMove = defaultAdjustBase traversePatchDMapWithMoveWithKey
--}
+
 {-
   traverseIntMapWithKeyWithAdjust = defaultAdjustIntBase traverseIntMapPatchWithKey
 -}
 
+{-
 instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT t m) where
   runWithReplace outerA0 outerA' = PerformEventT $ runWithReplaceRequesterTWith f (coerce outerA0) (coerceEvent outerA')
     where f :: HostFrame t a -> Event t (HostFrame t b) -> RequesterT t (HostFrame t) Identity (HostFrame t) (a, Event t b)
@@ -106,7 +106,6 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT
             result0 <- lift a0
             result' <- requestingIdentity a'
             return (result0, result')
-            {-
   traverseIntMapWithKeyWithAdjust f outerDm0 outerDm' = PerformEventT $ traverseIntMapWithKeyWithAdjustRequesterTWith (defaultAdjustIntBase traverseIntMapPatchWithKey) patchIntMapNewElementsMap mergeIntIncremental (\k v -> unPerformEventT $ f k v) (coerce outerDm0) (coerceEvent outerDm')
   traverseDMapWithKeyWithAdjust f outerDm0 outerDm' = PerformEventT $ traverseDMapWithKeyWithAdjustRequesterTWith (defaultAdjustBase traversePatchDMapWithKey) mapPatchDMap weakenPatchDMapWith patchMapNewElementsMap mergeMapIncremental (\k v -> unPerformEventT $ f k v) (coerce outerDm0) (coerceEvent outerDm')
   traverseDMapWithKeyWithAdjustWithMove f outerDm0 outerDm' = PerformEventT $ traverseDMapWithKeyWithAdjustRequesterTWith (defaultAdjustBase traversePatchDMapWithMoveWithKey) mapPatchDMapWithMove weakenPatchDMapWithMoveWith patchMapWithMoveNewElementsMap mergeMapIncrementalWithMove (\k v -> unPerformEventT $ f k v) (coerce outerDm0) (coerceEvent outerDm')
@@ -150,6 +149,7 @@ hostPerformEventT :: forall t m a.
                      , MonadReflexHost t m
                      , MonadRef m
                      , Ref m ~ Ref IO
+                     , PrimMonad (HostFrame t)
                      )
                   => PerformEventT t m a
                   -> m (a, FireCommand t m)
diff --git a/src/Reflex/Requester/Base.hs b/src/Reflex/Requester/Base.hs
index 91a3eb16..5f461d79 100644
--- a/src/Reflex/Requester/Base.hs
+++ b/src/Reflex/Requester/Base.hs
@@ -1,24 +1,5 @@
 -- | This module provides 'RequesterT', the standard implementation of
 -- 'Requester'.
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE EmptyDataDecls #-}
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE RecursiveDo #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE InstanceSigs #-}
-#ifdef USE_REFLEX_OPTIMIZER
-{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
-#endif
 module Reflex.Requester.Base
   ( RequesterT (..)
   , runRequesterT
@@ -35,623 +16,4 @@ module Reflex.Requester.Base
 --  , requesting'
   ) where
 
-import Reflex.Class
-import Reflex.Adjustable.Class
-import Reflex.Dynamic
-import Reflex.Host.Class
-import Reflex.PerformEvent.Class
-import Reflex.PostBuild.Class
-import Reflex.Requester.Class
-import Reflex.TriggerEvent.Class
-import Reflex.EventWriter.Base
-import Reflex.EventWriter.Class
-
-import Control.Applicative (liftA2)
-import Control.Monad.Exception
-import Control.Monad.Identity
-import Control.Monad.Primitive
-import Control.Monad.Reader
-import Control.Monad.Ref
-import Control.Monad.State.Strict
-import Data.Bits
-import Data.Coerce
-import Data.Dependent.Map (DMap, DSum (..))
-import qualified Data.Dependent.Map as DMap
-import Data.Functor.Compose
-import Data.Functor.Misc
-import Data.IntMap.Strict (IntMap)
-import qualified Data.IntMap.Strict as IntMap
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Monoid ((<>))
-import Data.Proxy
-import qualified Data.Semigroup as S
-import Data.Some (Some(Some))
-import Data.Type.Equality
-import Data.Sequence (Seq)
-import qualified Data.Sequence as Seq
-import Data.TagMap
-import Reflex.FanTag
-import Data.Unique.Tag.Local
-import qualified Data.Unique.Tag as Global
-import Data.GADT.Compare
-
-data RequestData m request = forall s. RequestData !(Global.Tag (PrimState m) s) !(Seq (RequestEnvelope s request))
-data ResponseData m response = forall s. ResponseData !(Global.Tag (PrimState m) s) !(TagMap s response)
-
-runRequesterT :: forall t request response m a
-  .  ( Reflex t
-     , PrimMonad m
-     , MonadFix m
-     )
-  => RequesterT t request response m a
-  -> Event t (ResponseData m response)
-  -> m (a, Event t (RequestData m request))
-runRequesterT (RequesterT a) wrappedResponses = withRequesterInternalT $ \(requests :: Event t (Seq (RequestEnvelope s request))) -> do
-  t :: Global.Tag (PrimState m) s <- lift Global.newTag
-  result <- a
-  let responses = fforMaybe wrappedResponses $ \(ResponseData s m) -> case s `geq` t of
-        Nothing -> Nothing --TODO: Warn somehow
-        Just Refl -> Just m
-  pure (responses, (result, fmap (RequestData t) requests))
-
-instance MonadTrans (RequesterInternalT s t request response) where
-  lift = RequesterInternalT . lift . lift . lift
-
-instance MonadTrans (RequesterT t request response) where
-  lift a = RequesterT $ RequesterInternalT $ lift $ lift $ lift a
-
--- | Run a 'RequesterT' action.  The resulting 'Event' will fire whenever
--- requests are made, and responses should be provided in the input 'Event'.
--- The 'Tag' keys will be used to return the responses to the same place the
--- requests were issued.
-withRequesterInternalT :: (Reflex t, PrimMonad m, MonadFix m)
-              => (forall s. Event t (Seq (RequestEnvelope s request)) -> RequesterInternalT s t request response m (Event t (TagMap s response), a))
-              -> m a
-withRequesterInternalT f = runTagGenT $ do
-  rec let RequesterInternalT a = f requests
-      ((responses, result), requests) <- runEventWriterT $ runReaderT a (fanTag responses)
-  pure result
-
-data RequestEnvelope s request = forall a. RequestEnvelope {-# UNPACK #-} !(Maybe (Tag s a)) !(request a)
-
-newtype RequesterT t (request :: * -> *) (response :: * -> *) m a = RequesterT { unRequesterT :: forall s. RequesterInternalT s t request response m a }
-
-instance Functor m => Functor (RequesterT t request response m) where
-  fmap f (RequesterT x) = RequesterT $ fmap f x
-
-instance Monad m => Applicative (RequesterT t request response m) where
-  pure x = RequesterT $ pure x
-  RequesterT f <*> RequesterT x = RequesterT $ f <*> x
-  liftA2 f (RequesterT a) (RequesterT b) = RequesterT $ liftA2 f a b
-  RequesterT f <* RequesterT x = RequesterT $ f <* x
-  RequesterT f *> RequesterT x = RequesterT $ f *> x
-
-instance Monad m => Monad (RequesterT t request response m) where
-  return = pure
-  RequesterT mx >>= f = RequesterT $ mx >>= \x -> case f x of
-    RequesterT y -> y
-
-instance MonadFix m => MonadFix (RequesterT t request response m) where
-  mfix f = RequesterT $ mfix $ \x -> case f x of
-    RequesterT a -> a
-
-instance MonadIO m => MonadIO (RequesterT t request respnose m) where
-  liftIO a = RequesterT $ liftIO a
-
-instance MonadException m => MonadException (RequesterT t request respnose m) where
-  throw e = RequesterT $ throw e
-
-newtype RequesterInternalT s t request response m a = RequesterInternalT { unRequesterInternalT :: ReaderT (EventSelectorTag t s response) (EventWriterT t (Seq (RequestEnvelope s request)) (TagGenT s m)) a }
-  deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException)
-
-instance MonadSample t m => MonadSample t (RequesterT t request response m)
-instance MonadHold t m => MonadHold t (RequesterT t request response m)
-instance PostBuild t m => PostBuild t (RequesterT t request response m)
-instance TriggerEvent t m => TriggerEvent t (RequesterT t request response m)
-
-instance PrimMonad m => PrimMonad (RequesterT t request response m) where
-  type PrimState (RequesterT t request response m) = PrimState m
-  primitive = lift . primitive
-
--- TODO: Monoid and Semigroup can likely be derived once StateT has them.
-instance (Monoid a, Monad m) => Monoid (RequesterT t request response m a) where
-  mempty = pure mempty
-  mappend = liftA2 mappend
-
-instance (S.Semigroup a, Monad m) => S.Semigroup (RequesterT t request response m a) where
-  (<>) = liftA2 (S.<>)
-
-instance PerformEvent t m => PerformEvent t (RequesterT t request response m) where
-  type Performable (RequesterT t request response m) = Performable m
-  performEvent_ = lift . performEvent_
-  performEvent = lift . performEvent
-
-instance MonadRef m => MonadRef (RequesterT t request response m) where
-  type Ref (RequesterT t request response m) = Ref m
-  newRef = lift . newRef
-  readRef = lift . readRef
-  writeRef r = lift . writeRef r
-
-instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (RequesterT t request response m) where
-  newEventWithTrigger = lift . newEventWithTrigger
-  newFanEventWithTrigger f = lift $ newFanEventWithTrigger f
-
-instance MonadReader r m => MonadReader r (RequesterT t request response m) where
-  ask = lift ask
-  local f (RequesterT a) = RequesterT $ RequesterInternalT $ mapReaderT (mapEventWriterT $ mapTagGenT $ local f) $ unRequesterInternalT a
-  reader = lift . reader
-
-instance (Reflex t, PrimMonad m) => Requester t (RequesterT t request response m) where
-  type Request (RequesterT t request response m) = request
-  type Response (RequesterT t request response m) = response
-  requesting e = RequesterT $ RequesterInternalT $ do
-    t <- lift $ lift mkTag
-    tellEvent $ fmapCheap (Seq.singleton . RequestEnvelope (Just t)) e
-    s <- ask
-    pure $ selectTag s t
-  requesting_ e = RequesterT $ RequesterInternalT $ do
-    tellEvent $ fmapCheap (Seq.singleton . RequestEnvelope Nothing) e
-
-
-{-# INLINABLE runWithReplaceRequesterTWith #-}
-runWithReplaceRequesterTWith :: forall m t request response a b. (Reflex t, MonadHold t m
-                                                                 , MonadFix m
-                                                                 )
-                             => (forall a' b'. m a' -> Event t (m b') -> RequesterT t request response m (a', Event t b'))
-                             -> RequesterT t request response m a
-                             -> Event t (RequesterT t request response m b)
-                             -> RequesterT t request response m (a, Event t b)
-runWithReplaceRequesterTWith f (RequesterT a0) a' = RequesterT $ do
-  pure undefined
-
-{-
-import GHC.Exts (Any)
-import Unsafe.Coerce
-
---TODO: Make this module type-safe
-
-newtype TagMap (f :: * -> *) = TagMap (IntMap Any)
-
-newtype RequesterData f = RequesterData (TagMap (Entry f))
-
-data RequesterDataKey a where
-  RequesterDataKey_Single :: {-# UNPACK #-} !(MyTag (Single a)) -> RequesterDataKey a
-  RequesterDataKey_Multi :: {-# UNPACK #-} !(MyTag Multi) -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a --TODO: Don't put a second Int here (or in the other Multis); use a single Int instead
-  RequesterDataKey_Multi2 :: {-# UNPACK #-} !(MyTag (Multi2 k)) -> !(Some k) -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a
-  RequesterDataKey_Multi3 :: {-# UNPACK #-} !(MyTag Multi3) -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a
-
-singletonRequesterData :: RequesterDataKey a -> f a -> RequesterData f
-singletonRequesterData rdk v = case rdk of
-  RequesterDataKey_Single k -> RequesterData $ singletonTagMap k $ Entry v
-  RequesterDataKey_Multi k k' k'' -> RequesterData $ singletonTagMap k $ Entry $ IntMap.singleton k' $ singletonRequesterData k'' v
-  RequesterDataKey_Multi2 k k' k'' k''' -> RequesterData $ singletonTagMap k $ Entry $ Map.singleton k' $ IntMap.singleton k'' $ singletonRequesterData k''' v
-  RequesterDataKey_Multi3 k k' k'' k''' -> RequesterData $ singletonTagMap k $ Entry $ IntMap.singleton k' $ IntMap.singleton k'' $ singletonRequesterData k''' v
-
-requesterDataToList :: RequesterData f -> [DSum RequesterDataKey f]
-requesterDataToList (RequesterData m) = do
-  k :=> Entry e <- tagMapToList m
-  case myKeyType k of
-    MyTagType_Single -> return $ RequesterDataKey_Single k :=> e
-    MyTagType_Multi -> do
-      (k', e') <- IntMap.toList e
-      k'' :=> e'' <- requesterDataToList e'
-      return $ RequesterDataKey_Multi k k' k'' :=> e''
-    MyTagType_Multi2 -> do
-      (k', e') <- Map.toList e
-      (k'', e'') <- IntMap.toList e'
-      k''' :=> e''' <- requesterDataToList e''
-      return $ RequesterDataKey_Multi2 k k' k'' k''' :=> e'''
-    MyTagType_Multi3 -> do
-      (k', e') <- IntMap.toList e
-      (k'', e'') <- IntMap.toList e'
-      k''' :=> e''' <- requesterDataToList e''
-      return $ RequesterDataKey_Multi3 k k' k'' k''' :=> e'''
-
-singletonTagMap :: forall f a. MyTag a -> f a -> TagMap f
-singletonTagMap (MyTag k) v = TagMap $ IntMap.singleton k $ (unsafeCoerce :: f a -> Any) v
-
-tagMapToList :: forall f. TagMap f -> [DSum MyTag f]
-tagMapToList (TagMap m) = f <$> IntMap.toList m
-  where f :: (Int, Any) -> DSum MyTag f
-        f (k, v) = MyTag k :=> (unsafeCoerce :: Any -> f a) v
-
-traverseTagMapWithKey :: forall t f g. Applicative t => (forall a. MyTag a -> f a -> t (g a)) -> TagMap f -> t (TagMap g)
-traverseTagMapWithKey f (TagMap m) = TagMap <$> IntMap.traverseWithKey g m
-  where
-    g :: Int -> Any -> t Any
-    g k v = (unsafeCoerce :: g a -> Any) <$> f (MyTag k) ((unsafeCoerce :: Any -> f a) v)
-
--- | Runs in reverse to accommodate for the fact that we accumulate it in reverse
-traverseRequesterData :: forall m request response. Applicative m => (forall a. request a -> m (response a)) -> RequesterData request -> m (RequesterData response)
-traverseRequesterData f (RequesterData m) = RequesterData <$> traverseTagMapWithKey go m --TODO: reverse this, since our tags are in reverse order
-  where go :: forall x. MyTag x -> Entry request x -> m (Entry response x)
-        go k (Entry request) = Entry <$> case myKeyType k of
-          MyTagType_Single -> f request
-          MyTagType_Multi -> traverse (traverseRequesterData f) request
-          MyTagType_Multi2 -> traverse (traverse (traverseRequesterData f)) request
-          MyTagType_Multi3 -> traverse (traverse (traverseRequesterData f)) request
-
--- | 'traverseRequesterData' with its arguments flipped
-forRequesterData :: forall request response m. Applicative m => RequesterData request -> (forall a. request a -> m (response a)) -> m (RequesterData response)
-forRequesterData r f = traverseRequesterData f r
-
-data MyTagType :: * -> * where
-  MyTagType_Single :: MyTagType (Single a)
-  MyTagType_Multi :: MyTagType Multi
-  MyTagType_Multi2 :: MyTagType (Multi2 k)
-  MyTagType_Multi3 :: MyTagType Multi3
-
-myKeyType :: MyTag x -> MyTagType x
-myKeyType (MyTag k) = case k .&. 0x3 of
-  0x0 -> unsafeCoerce MyTagType_Single
-  0x1 -> unsafeCoerce MyTagType_Multi
-  0x2 -> unsafeCoerce MyTagType_Multi2
-  0x3 -> unsafeCoerce MyTagType_Multi3
-  t -> error $ "Reflex.Requester.Base.myKeyType: no such key type" <> show t
-
-data Single a
-data Multi
-data Multi2 (k :: * -> *)
-data Multi3
-
-class MyTagTypeOffset x where
-  myTagTypeOffset :: proxy x -> Int
-
-instance MyTagTypeOffset (Single a) where
-  myTagTypeOffset _ = 0x0
-
-instance MyTagTypeOffset Multi where
-  myTagTypeOffset _ = 0x1
-
-instance MyTagTypeOffset (Multi2 k) where
-  myTagTypeOffset _ = 0x2
-
-instance MyTagTypeOffset Multi3 where
-  myTagTypeOffset _ = 0x3
-
-type family EntryContents request a where
-  EntryContents request (Single a) = request a
-  EntryContents request Multi = IntMap (RequesterData request)
-  EntryContents request (Multi2 k) = Map (Some k) (IntMap (RequesterData request))
-  EntryContents request Multi3 = IntMap (IntMap (RequesterData request))
-
-newtype Entry request x = Entry { unEntry :: EntryContents request x }
-
-{-# INLINE singleEntry #-}
-singleEntry :: f a -> Entry f (Single a)
-singleEntry = Entry
-
-{-# INLINE multiEntry #-}
-multiEntry :: IntMap (RequesterData f) -> Entry f Multi
-multiEntry = Entry
-
-{-# INLINE unMultiEntry #-}
-unMultiEntry :: Entry f Multi -> IntMap (RequesterData f)
-unMultiEntry = unEntry
-
--- | We use a hack here to pretend we have x ~ request a; we don't want to use a GADT, because GADTs (even with zero-size existential contexts) can't be newtypes
--- WARNING: This type should never be exposed.  In particular, this is extremely unsound if a MyTag from one run of runRequesterT is ever compared against a MyTag from another
-newtype MyTag x = MyTag Int deriving (Show, Eq, Ord, Enum)
-
-newtype MyTagWrap (f :: * -> *) x = MyTagWrap Int deriving (Show, Eq, Ord, Enum)
-
-{-# INLINE castMyTagWrap #-}
-castMyTagWrap :: MyTagWrap f (Entry f x) -> MyTagWrap g (Entry g x)
-castMyTagWrap = coerce
-
-instance GEq MyTag where
-  (MyTag a) `geq` (MyTag b) =
-    if a == b
-    then Just $ unsafeCoerce Refl
-    else Nothing
-
-instance GCompare MyTag where
-  (MyTag a) `gcompare` (MyTag b) =
-    case a `compare` b of
-      LT -> GLT
-      EQ -> unsafeCoerce GEQ
-      GT -> GGT
-
-instance GEq (MyTagWrap f) where
-  (MyTagWrap a) `geq` (MyTagWrap b) =
-    if a == b
-    then Just $ unsafeCoerce Refl
-    else Nothing
-
-instance GCompare (MyTagWrap f) where
-  (MyTagWrap a) `gcompare` (MyTagWrap b) =
-    case a `compare` b of
-      LT -> GLT
-      EQ -> unsafeCoerce GEQ
-      GT -> GGT
-
-data RequesterState t (request :: * -> *) = RequesterState
-  { _requesterState_nextMyTag :: {-# UNPACK #-} !Int -- Starts at -4 and goes down by 4 each time, to accommodate two 'type' bits at the bottom
-  , _requesterState_requests :: ![(Int, Event t Any)]
-  }
-
--- | A basic implementation of 'Requester'.
-newtype RequesterT t request (response :: * -> *) m a = RequesterT { unRequesterT :: StateT (RequesterState t request) (ReaderT (EventSelectorInt t Any) m) a }
-  deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException
--- MonadAsyncException can't be derived on ghc-8.0.1; we use base-4.9.1 as a proxy for ghc-8.0.2
-#if MIN_VERSION_base(4,9,1)
-           , MonadAsyncException
-#endif
-           )
-
-
--- | Run a 'RequesterT' action.  The resulting 'Event' will fire whenever
--- requests are made, and responses should be provided in the input 'Event'.
--- The 'Tag' keys will be used to return the responses to the same place the
--- requests were issued.
-runRequesterT :: (Reflex t, Monad m)
-              => RequesterT t request response m a
-              -> Event t (RequesterData response) --TODO: This DMap will be in reverse order, so we need to make sure the caller traverses it in reverse
-              -> m (a, Event t (RequesterData request)) --TODO: we need to hide these 'MyTag's here, because they're unsafe to mix in the wild
-runRequesterT (RequesterT a) responses = do
-  (result, s) <- runReaderT (runStateT a $ RequesterState (-4) []) $ fanInt $
-    coerceEvent responses
-  return (result, fmapCheap (RequesterData . TagMap) $ mergeInt $ IntMap.fromDistinctAscList $ _requesterState_requests s)
-
--- | Map a function over the request and response of a 'RequesterT'
-withRequesterT
-  :: (Reflex t, MonadFix m)
-  => (forall x. req x -> req' x) -- ^ The function to map over the request
-  -> (forall x. rsp' x -> rsp x) -- ^ The function to map over the response
-  -> RequesterT t req rsp m a -- ^ The internal 'RequesterT' whose input and output will be transformed
-  -> RequesterT t req' rsp' m a -- ^ The resulting 'RequesterT'
-withRequesterT freq frsp child = do
-  rec let rsp = fmap (runIdentity . traverseRequesterData (Identity . frsp)) rsp'
-      (a, req) <- lift $ runRequesterT child rsp
-      rsp' <- fmap (flip selectInt 0 . fanInt . fmapCheap unMultiEntry) $ requesting' $
-        fmapCheap (multiEntry . IntMap.singleton 0) $ fmap (runIdentity . traverseRequesterData (Identity . freq)) req
-  return a
-
-instance (Reflex t, Monad m) => Requester t (RequesterT t request response m) where
-  type Request (RequesterT t request response m) = request
-  type Response (RequesterT t request response m) = response
-  requesting = fmap coerceEvent . responseFromTag . castMyTagWrap <=< tagRequest . (coerceEvent :: Event t (request a) -> Event t (Entry request (Single a)))
-  requesting_ = void . tagRequest . fmapCheap singleEntry
-
-{-# INLINE tagRequest #-}
-tagRequest :: forall m x t request response. (Monad m, MyTagTypeOffset x) => Event t (Entry request x) -> RequesterT t request response m (MyTagWrap request (Entry request x))
-tagRequest req = do
-  old <- RequesterT get
-  let n = _requesterState_nextMyTag old .|. myTagTypeOffset (Proxy :: Proxy x)
-      t = MyTagWrap n
-  RequesterT $ put $ RequesterState
-    { _requesterState_nextMyTag = _requesterState_nextMyTag old - 0x4
-    , _requesterState_requests = (n, (unsafeCoerce :: Event t (Entry request x) -> Event t Any) req) : _requesterState_requests old
-    }
-  return t
-
-{-# INLINE responseFromTag #-}
-responseFromTag :: Monad m => MyTagWrap response (Entry response x) -> RequesterT t request response m (Event t (Entry response x))
-responseFromTag (MyTagWrap t) = do
-  responses :: EventSelectorInt t Any <- RequesterT ask
-  return $ (unsafeCoerce :: Event t Any -> Event t (Entry response x)) $ selectInt responses t
-
-instance MonadTrans (RequesterT t request response) where
-  lift = RequesterT . lift . lift
-
-instance PerformEvent t m => PerformEvent t (RequesterT t request response m) where
-  type Performable (RequesterT t request response m) = Performable m
-  performEvent_ = lift . performEvent_
-  performEvent = lift . performEvent
-
-instance MonadRef m => MonadRef (RequesterT t request response m) where
-  type Ref (RequesterT t request response m) = Ref m
-  newRef = lift . newRef
-  readRef = lift . readRef
-  writeRef r = lift . writeRef r
-
-instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (RequesterT t request response m) where
-  newEventWithTrigger = lift . newEventWithTrigger
-  newFanEventWithTrigger f = lift $ newFanEventWithTrigger f
-
-instance MonadReader r m => MonadReader r (RequesterT t request response m) where
-  ask = lift ask
-  local f (RequesterT a) = RequesterT $ mapStateT (mapReaderT $ local f) a
-  reader = lift . reader
-
-instance (Reflex t, Adjustable t m, MonadHold t m, MonadFix m) => Adjustable t (RequesterT t request response m) where
-  runWithReplace = runWithReplaceRequesterTWith $ \dm0 dm' -> lift $ runWithReplace dm0 dm'
-  traverseIntMapWithKeyWithAdjust = traverseIntMapWithKeyWithAdjustRequesterTWith (\f dm0 dm' -> lift $ traverseIntMapWithKeyWithAdjust f dm0 dm') patchIntMapNewElementsMap mergeIntIncremental
-  {-# INLINABLE traverseDMapWithKeyWithAdjust #-}
-  traverseDMapWithKeyWithAdjust = traverseDMapWithKeyWithAdjustRequesterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjust f dm0 dm') mapPatchDMap weakenPatchDMapWith patchMapNewElementsMap mergeMapIncremental
-  traverseDMapWithKeyWithAdjustWithMove = traverseDMapWithKeyWithAdjustRequesterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjustWithMove f dm0 dm') mapPatchDMapWithMove weakenPatchDMapWithMoveWith patchMapWithMoveNewElementsMap mergeMapIncrementalWithMove
-
-requesting' :: (MyTagTypeOffset x, Monad m) => Event t (Entry request x) -> RequesterT t request response m (Event t (Entry response x))
-requesting' = responseFromTag . castMyTagWrap <=< tagRequest
-
-{-# INLINABLE runWithReplaceRequesterTWith #-}
-runWithReplaceRequesterTWith :: forall m t request response a b. (Reflex t, MonadHold t m
-                                                                 , MonadFix m
-                                                                 )
-                             => (forall a' b'. m a' -> Event t (m b') -> RequesterT t request response m (a', Event t b'))
-                             -> RequesterT t request response m a
-                             -> Event t (RequesterT t request response m b)
-                             -> RequesterT t request response m (a, Event t b)
-runWithReplaceRequesterTWith f a0 a' = do
-  rec na' <- numberOccurrencesFrom 1 a'
-      responses <- fmap (fmapCheap unMultiEntry) $ requesting' $ fmapCheap multiEntry $ switchPromptlyDyn requests --TODO: Investigate whether we can really get rid of the prompt stuff here
-      let responses' = fanInt responses
-      ((result0, requests0), v') <- f (runRequesterT a0 (selectInt responses' 0)) $ fmapCheap (\(n, a) -> fmap ((,) n) $ runRequesterT a $ selectInt responses' n) na'
-      requests <- holdDyn (fmapCheap (IntMap.singleton 0) requests0) $ fmapCheap (\(n, (_, reqs)) -> fmapCheap (IntMap.singleton n) reqs) v'
-  return (result0, fmapCheap (fst . snd) v')
-
-{-# INLINE traverseIntMapWithKeyWithAdjustRequesterTWith #-}
-traverseIntMapWithKeyWithAdjustRequesterTWith :: forall t request response m v v' p.
-                                        ( Reflex t
-                                        , MonadHold t m
-                                        , PatchTarget (p (Event t (IntMap (RequesterData request)))) ~ IntMap (Event t (IntMap (RequesterData request)))
-                                        , Patch (p (Event t (IntMap (RequesterData request))))
-                                        , Functor p
-                                        , MonadFix m
-                                        )
-                                     => (   (IntMap.Key -> (IntMap.Key, v) -> m (Event t (IntMap (RequesterData request)), v'))
-                                         -> IntMap (IntMap.Key, v)
-                                         -> Event t (p (IntMap.Key, v))
-                                         -> RequesterT t request response m (IntMap (Event t (IntMap (RequesterData request)), v'), Event t (p (Event t (IntMap (RequesterData request)), v')))
-                                        )
-                                     -> (p (Event t (IntMap (RequesterData request))) -> IntMap (Event t (IntMap (RequesterData request))))
-                                     -> (Incremental t (p (Event t (IntMap (RequesterData request)))) -> Event t (IntMap (IntMap (RequesterData request))))
-                                     -> (IntMap.Key -> v -> RequesterT t request response m v')
-                                     -> IntMap v
-                                     -> Event t (p v)
-                                     -> RequesterT t request response m (IntMap v', Event t (p v'))
-traverseIntMapWithKeyWithAdjustRequesterTWith base patchNewElements mergePatchIncremental f dm0 dm' = do
-  rec response <- requesting' $ fmapCheap pack $ promptRequests `mappend` mergePatchIncremental requests --TODO: Investigate whether we can really get rid of the prompt stuff here
-      let responses :: EventSelectorInt t (IntMap (RequesterData response))
-          responses = fanInt $ fmapCheap unpack response
-          unpack :: Entry response Multi3 -> IntMap (IntMap (RequesterData response))
-          unpack = unEntry
-          pack :: IntMap (IntMap (RequesterData request)) -> Entry request Multi3
-          pack = Entry
-          f' :: IntMap.Key -> (Int, v) -> m (Event t (IntMap (RequesterData request)), v')
-          f' k (n, v) = do
-            (result, myRequests) <- runRequesterT (f k v) $ mapMaybeCheap (IntMap.lookup n) $ selectInt responses k --TODO: Instead of doing mapMaybeCheap, can we share a fanInt across all instances of a given key, or at least the ones that are adjacent in time?
-            return (fmapCheap (IntMap.singleton n) myRequests, result)
-      ndm' <- numberOccurrencesFrom 1 dm'
-      (children0, children') <- base f' (fmap ((,) 0) dm0) $ fmap (\(n, dm) -> fmap ((,) n) dm) ndm' --TODO: Avoid this somehow, probably by adding some sort of per-cohort information passing to Adjustable
-      let result0 = fmap snd children0
-          result' = fforCheap children' $ fmap snd
-          requests0 :: IntMap (Event t (IntMap (RequesterData request)))
-          requests0 = fmap fst children0
-          requests' :: Event t (p (Event t (IntMap (RequesterData request))))
-          requests' = fforCheap children' $ fmap fst
-          promptRequests :: Event t (IntMap (IntMap (RequesterData request)))
-          promptRequests = coincidence $ fmapCheap (mergeInt . patchNewElements) requests' --TODO: Create a mergeIncrementalPromptly, and use that to eliminate this 'coincidence'
-      requests <- holdIncremental requests0 requests'
-  return (result0, result')
-
-{-# INLINE traverseDMapWithKeyWithAdjustRequesterTWith #-}
-traverseDMapWithKeyWithAdjustRequesterTWith :: forall k t request response m v v' p p'.
-                                        ( GCompare k
-                                        , Reflex t
-                                        , MonadHold t m
-                                        , PatchTarget (p' (Some k) (Event t (IntMap (RequesterData request)))) ~ Map (Some k) (Event t (IntMap (RequesterData request)))
-                                        , Patch (p' (Some k) (Event t (IntMap (RequesterData request))))
-                                        , MonadFix m
-                                        )
-                                     => (forall k' v1 v2. GCompare k'
-                                         => (forall a. k' a -> v1 a -> m (v2 a))
-                                         -> DMap k' v1
-                                         -> Event t (p k' v1)
-                                         -> RequesterT t request response m (DMap k' v2, Event t (p k' v2))
-                                        )
-                                     -> (forall v1 v2. (forall a. v1 a -> v2 a) -> p k v1 -> p k v2)
-                                     -> (forall v1 v2. (forall a. v1 a -> v2) -> p k v1 -> p' (Some k) v2)
-                                     -> (forall v2. p' (Some k) v2 -> Map (Some k) v2)
-                                     -> (forall a. Incremental t (p' (Some k) (Event t a)) -> Event t (Map (Some k) a))
-                                     -> (forall a. k a -> v a -> RequesterT t request response m (v' a))
-                                     -> DMap k v
-                                     -> Event t (p k v)
-                                     -> RequesterT t request response m (DMap k v', Event t (p k v'))
-traverseDMapWithKeyWithAdjustRequesterTWith base mapPatch weakenPatchWith patchNewElements mergePatchIncremental f dm0 dm' = do
-  rec response <- requesting' $ fmapCheap pack $ promptRequests `mappend` mergePatchIncremental requests --TODO: Investigate whether we can really get rid of the prompt stuff here
-      let responses :: EventSelector t (Const2 (Some k) (IntMap (RequesterData response)))
-          responses = fanMap $ fmapCheap unpack response
-          unpack :: Entry response (Multi2 k) -> Map (Some k) (IntMap (RequesterData response))
-          unpack = unEntry
-          pack :: Map (Some k) (IntMap (RequesterData request)) -> Entry request (Multi2 k)
-          pack = Entry
-          f' :: forall a. k a -> Compose ((,) Int) v a -> m (Compose ((,) (Event t (IntMap (RequesterData request)))) v' a)
-          f' k (Compose (n, v)) = do
-            (result, myRequests) <- runRequesterT (f k v) $ mapMaybeCheap (IntMap.lookup n) $ select responses (Const2 (Some k))
-            return $ Compose (fmapCheap (IntMap.singleton n) myRequests, result)
-      ndm' <- numberOccurrencesFrom 1 dm'
-      (children0, children') <- base f' (DMap.map (\v -> Compose (0, v)) dm0) $ fmap (\(n, dm) -> mapPatch (\v -> Compose (n, v)) dm) ndm'
-      let result0 = DMap.map (snd . getCompose) children0
-          result' = fforCheap children' $ mapPatch $ snd . getCompose
-          requests0 :: Map (Some k) (Event t (IntMap (RequesterData request)))
-          requests0 = weakenDMapWith (fst . getCompose) children0
-          requests' :: Event t (p' (Some k) (Event t (IntMap (RequesterData request))))
-          requests' = fforCheap children' $ weakenPatchWith $ fst . getCompose
-          promptRequests :: Event t (Map (Some k) (IntMap (RequesterData request)))
-          promptRequests = coincidence $ fmapCheap (mergeMap . patchNewElements) requests' --TODO: Create a mergeIncrementalPromptly, and use that to eliminate this 'coincidence'
-      requests <- holdIncremental requests0 requests'
-  return (result0, result')
-
-data Decoder rawResponse response =
-  forall a. Decoder (RequesterDataKey a) (rawResponse -> response a)
-
--- | Matches incoming responses with previously-sent requests
--- and uses the provided request "decoder" function to process
--- incoming responses.
-matchResponsesWithRequests
-  :: forall t rawRequest rawResponse request response m.
-     ( MonadFix m
-     , MonadHold t m
-     , Reflex t
-     )
-  => (forall a. request a -> (rawRequest, rawResponse -> response a))
-  -- ^ Given a request (from 'Requester'), produces the wire format of the
-  -- request and a function used to process the associated response
-  -> Event t (RequesterData request)
-  -- ^ The outgoing requests
-  -> Event t (Int, rawResponse)
-  -- ^ The incoming responses, tagged by an identifying key
-  -> m ( Event t (Map Int rawRequest)
-       , Event t (RequesterData response)
-       )
-  -- ^ A map of outgoing wire-format requests and an event of responses keyed
-  -- by the 'RequesterData' key of the associated outgoing request
-matchResponsesWithRequests f send recv = do
-  rec nextId <- hold 1 $ fmap (\(next, _, _) -> next) outgoing
-      waitingFor :: Incremental t (PatchMap Int (Decoder rawResponse response)) <-
-        holdIncremental mempty $ leftmost
-          [ fmap (\(_, outstanding, _) -> outstanding) outgoing
-          , snd <$> incoming
-          ]
-      let outgoing = processOutgoing nextId send
-          incoming = processIncoming waitingFor recv
-  return (fmap (\(_, _, rawReqs) -> rawReqs) outgoing, fst <$> incoming)
-  where
-    -- Tags each outgoing request with an identifying integer key
-    -- and returns the next available key, a map of response decoders
-    -- for requests for which there are outstanding responses, and the
-    -- raw requests to be sent out.
-    processOutgoing
-      :: Behavior t Int
-      -- The next available key
-      -> Event t (RequesterData request)
-      -- The outgoing request
-      -> Event t ( Int
-                 , PatchMap Int (Decoder rawResponse response)
-                 , Map Int rawRequest )
-      -- The new next-available-key, a map of requests expecting responses, and the tagged raw requests
-    processOutgoing nextId out = flip pushAlways out $ \dm -> do
-      oldNextId <- sample nextId
-      let (result, newNextId) = flip runState oldNextId $ forM (requesterDataToList dm) $ \(k :=> v) -> do
-            n <- get
-            put $ succ n
-            let (rawReq, rspF) = f v
-            return (n, rawReq, Decoder k rspF)
-          patchWaitingFor = PatchMap $ Map.fromList $
-            (\(n, _, dec) -> (n, Just dec)) <$> result
-          toSend = Map.fromList $ (\(n, rawReq, _) -> (n, rawReq)) <$> result
-      return (newNextId, patchWaitingFor, toSend)
-    -- Looks up the each incoming raw response in a map of response
-    -- decoders and returns the decoded response and a patch that can
-    -- be used to clear the ID of the consumed response out of the queue
-    -- of expected responses.
-    processIncoming
-      :: Incremental t (PatchMap Int (Decoder rawResponse response))
-      -- A map of outstanding expected responses
-      -> Event t (Int, rawResponse)
-      -- A incoming response paired with its identifying key
-      -> Event t (RequesterData response, PatchMap Int v)
-      -- The decoded response and a patch that clears the outstanding responses queue
-    processIncoming waitingFor inc = flip push inc $ \(n, rawRsp) -> do
-      wf <- sample $ currentIncremental waitingFor
-      case Map.lookup n wf of
-        Nothing -> return Nothing -- TODO How should lookup failures be handled here? They shouldn't ever happen..
-        Just (Decoder k rspF) -> do
-          let rsp = rspF rawRsp
-          return $ Just
-            ( singletonRequesterData k rsp
-            , PatchMap $ Map.singleton n Nothing
-            )
--}
+import Reflex.Requester.Base.Internal
diff --git a/src/Reflex/Requester/Base/Internal.hs b/src/Reflex/Requester/Base/Internal.hs
new file mode 100644
index 00000000..9dbf0653
--- /dev/null
+++ b/src/Reflex/Requester/Base/Internal.hs
@@ -0,0 +1,661 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE RecursiveDo #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE InstanceSigs #-}
+#ifdef USE_REFLEX_OPTIMIZER
+{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
+#endif
+module Reflex.Requester.Base.Internal where
+
+import Reflex.Class
+import Reflex.Adjustable.Class
+import Reflex.Dynamic
+import Reflex.Host.Class
+import Reflex.PerformEvent.Class
+import Reflex.PostBuild.Class
+import Reflex.Requester.Class
+import Reflex.TriggerEvent.Class
+import Reflex.EventWriter.Base
+import Reflex.EventWriter.Class
+
+import Control.Applicative (liftA2)
+import Control.Monad.Exception
+import Control.Monad.Identity
+import Control.Monad.Primitive
+import Control.Monad.Reader
+import Control.Monad.Ref
+import Control.Monad.State.Strict
+import Data.Bits
+import Data.Coerce
+import Data.Dependent.Map (DMap, DSum (..))
+import qualified Data.Dependent.Map as DMap
+import Data.Functor.Compose
+import Data.Functor.Misc
+import Data.IntMap.Strict (IntMap)
+import qualified Data.IntMap.Strict as IntMap
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Monoid ((<>))
+import Data.Proxy
+import qualified Data.Semigroup as S
+import Data.Some (Some(Some))
+import Data.Type.Equality
+import Data.Sequence (Seq)
+import qualified Data.Sequence as Seq
+import Data.TagMap (TagMap)
+import qualified Data.TagMap as TagMap
+import Reflex.FanTag
+import Data.Unique.Tag.Local
+import qualified Data.Unique.Tag as Global
+import Data.GADT.Compare
+import Data.Witherable
+import Data.Foldable
+
+data RequestData ps request = forall s. RequestData !(TagGen ps s) !(Seq (RequestEnvelope s request))
+data ResponseData ps response = forall s. ResponseData !(TagGen ps s) !(TagMap s response)
+
+traverseRequesterData :: forall m request response. Applicative m => (forall a. request a -> m (response a)) -> RequestData (PrimState m) request -> m (ResponseData (PrimState m) response)
+traverseRequesterData f (RequestData tg es) = ResponseData tg . TagMap.fromList <$> wither g (toList es)
+  where g (RequestEnvelope mt req) = case mt of
+          Just t -> (\rsp -> Just $ t :=> rsp) <$> f req
+          Nothing -> Nothing <$ f req
+
+runRequesterT :: forall t request response m a
+  .  ( Reflex t
+     , PrimMonad m
+     , MonadFix m
+     )
+  => RequesterT t request response m a
+  -> Event t (ResponseData (PrimState m) response)
+  -> m (a, Event t (RequestData (PrimState m) request))
+runRequesterT (RequesterT a) wrappedResponses = withRequesterInternalT $ \(requests :: Event t (Seq (RequestEnvelope s request))) -> do
+  (_, tg) <- RequesterInternalT ask
+  result <- a
+  let responses = fforMaybe wrappedResponses $ \(ResponseData tg' m) -> case tg `geq` tg' of
+        Nothing -> Nothing --TODO: Warn somehow
+        Just Refl -> Just m
+  pure (responses, (result, fmapCheap (RequestData tg) requests))
+
+instance MonadTrans (RequesterInternalT s t request response) where
+  lift = RequesterInternalT . lift . lift
+
+instance MonadTrans (RequesterT t request response) where
+  lift a = RequesterT $ RequesterInternalT $ lift $ lift a
+
+-- | Run a 'RequesterT' action.  The resulting 'Event' will fire whenever
+-- requests are made, and responses should be provided in the input 'Event'.
+-- The 'Tag' keys will be used to return the responses to the same place the
+-- requests were issued.
+withRequesterInternalT
+  :: ( Reflex t
+     , PrimMonad m
+     , MonadFix m
+     )
+  => (forall s. Event t (Seq (RequestEnvelope s request)) -> RequesterInternalT s t request response m (Event t (TagMap s response), a))
+  -> m a
+withRequesterInternalT f = withTagGen $ \tg -> do
+  rec let RequesterInternalT a = f requests
+      ((responses, result), requests) <- runEventWriterT $ runReaderT a (fanTag responses, tg)
+  pure result
+
+data RequestEnvelope s request = forall a. RequestEnvelope {-# UNPACK #-} !(Maybe (Tag s a)) !(request a)
+
+newtype RequesterT t (request :: * -> *) (response :: * -> *) m a = RequesterT { unRequesterT :: forall s. RequesterInternalT s t request response m a }
+
+instance Functor m => Functor (RequesterT t request response m) where
+  fmap f (RequesterT x) = RequesterT $ fmap f x
+
+instance Monad m => Applicative (RequesterT t request response m) where
+  pure x = RequesterT $ pure x
+  RequesterT f <*> RequesterT x = RequesterT $ f <*> x
+  liftA2 f (RequesterT a) (RequesterT b) = RequesterT $ liftA2 f a b
+  RequesterT f <* RequesterT x = RequesterT $ f <* x
+  RequesterT f *> RequesterT x = RequesterT $ f *> x
+
+instance Monad m => Monad (RequesterT t request response m) where
+  return = pure
+  RequesterT mx >>= f = RequesterT $ mx >>= \x -> case f x of
+    RequesterT y -> y
+
+instance MonadFix m => MonadFix (RequesterT t request response m) where
+  mfix f = RequesterT $ mfix $ \x -> case f x of
+    RequesterT a -> a
+
+instance MonadIO m => MonadIO (RequesterT t request respnose m) where
+  liftIO a = RequesterT $ liftIO a
+
+instance MonadException m => MonadException (RequesterT t request respnose m) where
+  throw e = RequesterT $ throw e
+
+newtype RequesterInternalT s t request response m a = RequesterInternalT { unRequesterInternalT :: ReaderT (EventSelectorTag t s response, TagGen (PrimState m) s) (EventWriterT t (Seq (RequestEnvelope s request)) m) a }
+  deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException)
+
+instance MonadSample t m => MonadSample t (RequesterT t request response m)
+instance MonadHold t m => MonadHold t (RequesterT t request response m)
+instance PostBuild t m => PostBuild t (RequesterT t request response m)
+instance TriggerEvent t m => TriggerEvent t (RequesterT t request response m)
+
+instance PrimMonad m => PrimMonad (RequesterT t request response m) where
+  type PrimState (RequesterT t request response m) = PrimState m
+  primitive = lift . primitive
+
+-- TODO: Monoid and Semigroup can likely be derived once StateT has them.
+instance (Monoid a, Monad m) => Monoid (RequesterT t request response m a) where
+  mempty = pure mempty
+  mappend = liftA2 mappend
+
+instance (S.Semigroup a, Monad m) => S.Semigroup (RequesterT t request response m a) where
+  (<>) = liftA2 (S.<>)
+
+instance PerformEvent t m => PerformEvent t (RequesterT t request response m) where
+  type Performable (RequesterT t request response m) = Performable m
+  performEvent_ = lift . performEvent_
+  performEvent = lift . performEvent
+
+instance MonadRef m => MonadRef (RequesterT t request response m) where
+  type Ref (RequesterT t request response m) = Ref m
+  newRef = lift . newRef
+  readRef = lift . readRef
+  writeRef r = lift . writeRef r
+
+instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (RequesterT t request response m) where
+  newEventWithTrigger = lift . newEventWithTrigger
+  newFanEventWithTrigger f = lift $ newFanEventWithTrigger f
+
+instance MonadReader r m => MonadReader r (RequesterT t request response m) where
+  ask = lift ask
+  local f (RequesterT a) = RequesterT $ RequesterInternalT $ mapReaderT (mapEventWriterT $ local f) $ unRequesterInternalT a
+  reader = lift . reader
+
+instance (Reflex t, PrimMonad m) => Requester t (RequesterT t request response m) where
+  type Request (RequesterT t request response m) = request
+  type Response (RequesterT t request response m) = response
+  requesting e = RequesterT $ requesting e
+  requesting_ e = RequesterT $ requesting_ e
+
+instance (Reflex t, PrimMonad m) => Requester t (RequesterInternalT s t request response m) where
+  type Request (RequesterInternalT s t request response m) = request
+  type Response (RequesterInternalT s t request response m) = response
+  requesting e = RequesterInternalT $ do
+    (s, tg) <- ask
+    t <- lift $ lift $ newTag tg
+    tellEvent $ fmapCheap (Seq.singleton . RequestEnvelope (Just t)) e
+    pure $ selectTag s t
+  requesting_ e = RequesterInternalT $ do
+    tellEvent $ fmapCheap (Seq.singleton . RequestEnvelope Nothing) e
+
+instance Adjustable t m => Adjustable t (RequesterInternalT s t request response m)
+
+{-# INLINABLE runWithReplaceRequesterTWith #-}
+runWithReplaceRequesterTWith :: forall m t request response a b. (Reflex t, MonadHold t m
+                                                                 , MonadFix m
+                                                                 )
+                             => (forall a' b'. m a' -> Event t (m b') -> RequesterT t request response m (a', Event t b'))
+                             -> RequesterT t request response m a
+                             -> Event t (RequesterT t request response m b)
+                             -> RequesterT t request response m (a, Event t b)
+runWithReplaceRequesterTWith f (RequesterT a0) a' = RequesterT $ do
+  pure undefined
+
+{-
+import GHC.Exts (Any)
+import Unsafe.Coerce
+
+--TODO: Make this module type-safe
+
+newtype TagMap (f :: * -> *) = TagMap (IntMap Any)
+
+newtype RequesterData f = RequesterData (TagMap (Entry f))
+
+data RequesterDataKey a where
+  RequesterDataKey_Single :: {-# UNPACK #-} !(MyTag (Single a)) -> RequesterDataKey a
+  RequesterDataKey_Multi :: {-# UNPACK #-} !(MyTag Multi) -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a --TODO: Don't put a second Int here (or in the other Multis); use a single Int instead
+  RequesterDataKey_Multi2 :: {-# UNPACK #-} !(MyTag (Multi2 k)) -> !(Some k) -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a
+  RequesterDataKey_Multi3 :: {-# UNPACK #-} !(MyTag Multi3) -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a
+
+singletonRequesterData :: RequesterDataKey a -> f a -> RequesterData f
+singletonRequesterData rdk v = case rdk of
+  RequesterDataKey_Single k -> RequesterData $ singletonTagMap k $ Entry v
+  RequesterDataKey_Multi k k' k'' -> RequesterData $ singletonTagMap k $ Entry $ IntMap.singleton k' $ singletonRequesterData k'' v
+  RequesterDataKey_Multi2 k k' k'' k''' -> RequesterData $ singletonTagMap k $ Entry $ Map.singleton k' $ IntMap.singleton k'' $ singletonRequesterData k''' v
+  RequesterDataKey_Multi3 k k' k'' k''' -> RequesterData $ singletonTagMap k $ Entry $ IntMap.singleton k' $ IntMap.singleton k'' $ singletonRequesterData k''' v
+
+requesterDataToList :: RequesterData f -> [DSum RequesterDataKey f]
+requesterDataToList (RequesterData m) = do
+  k :=> Entry e <- tagMapToList m
+  case myKeyType k of
+    MyTagType_Single -> return $ RequesterDataKey_Single k :=> e
+    MyTagType_Multi -> do
+      (k', e') <- IntMap.toList e
+      k'' :=> e'' <- requesterDataToList e'
+      return $ RequesterDataKey_Multi k k' k'' :=> e''
+    MyTagType_Multi2 -> do
+      (k', e') <- Map.toList e
+      (k'', e'') <- IntMap.toList e'
+      k''' :=> e''' <- requesterDataToList e''
+      return $ RequesterDataKey_Multi2 k k' k'' k''' :=> e'''
+    MyTagType_Multi3 -> do
+      (k', e') <- IntMap.toList e
+      (k'', e'') <- IntMap.toList e'
+      k''' :=> e''' <- requesterDataToList e''
+      return $ RequesterDataKey_Multi3 k k' k'' k''' :=> e'''
+
+singletonTagMap :: forall f a. MyTag a -> f a -> TagMap f
+singletonTagMap (MyTag k) v = TagMap $ IntMap.singleton k $ (unsafeCoerce :: f a -> Any) v
+
+tagMapToList :: forall f. TagMap f -> [DSum MyTag f]
+tagMapToList (TagMap m) = f <$> IntMap.toList m
+  where f :: (Int, Any) -> DSum MyTag f
+        f (k, v) = MyTag k :=> (unsafeCoerce :: Any -> f a) v
+
+traverseTagMapWithKey :: forall t f g. Applicative t => (forall a. MyTag a -> f a -> t (g a)) -> TagMap f -> t (TagMap g)
+traverseTagMapWithKey f (TagMap m) = TagMap <$> IntMap.traverseWithKey g m
+  where
+    g :: Int -> Any -> t Any
+    g k v = (unsafeCoerce :: g a -> Any) <$> f (MyTag k) ((unsafeCoerce :: Any -> f a) v)
+
+-- | Runs in reverse to accommodate for the fact that we accumulate it in reverse
+traverseRequesterData :: forall m request response. Applicative m => (forall a. request a -> m (response a)) -> RequesterData request -> m (RequesterData response)
+traverseRequesterData f (RequesterData m) = RequesterData <$> traverseTagMapWithKey go m --TODO: reverse this, since our tags are in reverse order
+  where go :: forall x. MyTag x -> Entry request x -> m (Entry response x)
+        go k (Entry request) = Entry <$> case myKeyType k of
+          MyTagType_Single -> f request
+          MyTagType_Multi -> traverse (traverseRequesterData f) request
+          MyTagType_Multi2 -> traverse (traverse (traverseRequesterData f)) request
+          MyTagType_Multi3 -> traverse (traverse (traverseRequesterData f)) request
+
+-- | 'traverseRequesterData' with its arguments flipped
+forRequesterData :: forall request response m. Applicative m => RequesterData request -> (forall a. request a -> m (response a)) -> m (RequesterData response)
+forRequesterData r f = traverseRequesterData f r
+
+data MyTagType :: * -> * where
+  MyTagType_Single :: MyTagType (Single a)
+  MyTagType_Multi :: MyTagType Multi
+  MyTagType_Multi2 :: MyTagType (Multi2 k)
+  MyTagType_Multi3 :: MyTagType Multi3
+
+myKeyType :: MyTag x -> MyTagType x
+myKeyType (MyTag k) = case k .&. 0x3 of
+  0x0 -> unsafeCoerce MyTagType_Single
+  0x1 -> unsafeCoerce MyTagType_Multi
+  0x2 -> unsafeCoerce MyTagType_Multi2
+  0x3 -> unsafeCoerce MyTagType_Multi3
+  t -> error $ "Reflex.Requester.Base.myKeyType: no such key type" <> show t
+
+data Single a
+data Multi
+data Multi2 (k :: * -> *)
+data Multi3
+
+class MyTagTypeOffset x where
+  myTagTypeOffset :: proxy x -> Int
+
+instance MyTagTypeOffset (Single a) where
+  myTagTypeOffset _ = 0x0
+
+instance MyTagTypeOffset Multi where
+  myTagTypeOffset _ = 0x1
+
+instance MyTagTypeOffset (Multi2 k) where
+  myTagTypeOffset _ = 0x2
+
+instance MyTagTypeOffset Multi3 where
+  myTagTypeOffset _ = 0x3
+
+type family EntryContents request a where
+  EntryContents request (Single a) = request a
+  EntryContents request Multi = IntMap (RequesterData request)
+  EntryContents request (Multi2 k) = Map (Some k) (IntMap (RequesterData request))
+  EntryContents request Multi3 = IntMap (IntMap (RequesterData request))
+
+newtype Entry request x = Entry { unEntry :: EntryContents request x }
+
+{-# INLINE singleEntry #-}
+singleEntry :: f a -> Entry f (Single a)
+singleEntry = Entry
+
+{-# INLINE multiEntry #-}
+multiEntry :: IntMap (RequesterData f) -> Entry f Multi
+multiEntry = Entry
+
+{-# INLINE unMultiEntry #-}
+unMultiEntry :: Entry f Multi -> IntMap (RequesterData f)
+unMultiEntry = unEntry
+
+-- | We use a hack here to pretend we have x ~ request a; we don't want to use a GADT, because GADTs (even with zero-size existential contexts) can't be newtypes
+-- WARNING: This type should never be exposed.  In particular, this is extremely unsound if a MyTag from one run of runRequesterT is ever compared against a MyTag from another
+newtype MyTag x = MyTag Int deriving (Show, Eq, Ord, Enum)
+
+newtype MyTagWrap (f :: * -> *) x = MyTagWrap Int deriving (Show, Eq, Ord, Enum)
+
+{-# INLINE castMyTagWrap #-}
+castMyTagWrap :: MyTagWrap f (Entry f x) -> MyTagWrap g (Entry g x)
+castMyTagWrap = coerce
+
+instance GEq MyTag where
+  (MyTag a) `geq` (MyTag b) =
+    if a == b
+    then Just $ unsafeCoerce Refl
+    else Nothing
+
+instance GCompare MyTag where
+  (MyTag a) `gcompare` (MyTag b) =
+    case a `compare` b of
+      LT -> GLT
+      EQ -> unsafeCoerce GEQ
+      GT -> GGT
+
+instance GEq (MyTagWrap f) where
+  (MyTagWrap a) `geq` (MyTagWrap b) =
+    if a == b
+    then Just $ unsafeCoerce Refl
+    else Nothing
+
+instance GCompare (MyTagWrap f) where
+  (MyTagWrap a) `gcompare` (MyTagWrap b) =
+    case a `compare` b of
+      LT -> GLT
+      EQ -> unsafeCoerce GEQ
+      GT -> GGT
+
+data RequesterState t (request :: * -> *) = RequesterState
+  { _requesterState_nextMyTag :: {-# UNPACK #-} !Int -- Starts at -4 and goes down by 4 each time, to accommodate two 'type' bits at the bottom
+  , _requesterState_requests :: ![(Int, Event t Any)]
+  }
+
+-- | A basic implementation of 'Requester'.
+newtype RequesterT t request (response :: * -> *) m a = RequesterT { unRequesterT :: StateT (RequesterState t request) (ReaderT (EventSelectorInt t Any) m) a }
+  deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException
+-- MonadAsyncException can't be derived on ghc-8.0.1; we use base-4.9.1 as a proxy for ghc-8.0.2
+#if MIN_VERSION_base(4,9,1)
+           , MonadAsyncException
+#endif
+           )
+
+
+-- | Run a 'RequesterT' action.  The resulting 'Event' will fire whenever
+-- requests are made, and responses should be provided in the input 'Event'.
+-- The 'Tag' keys will be used to return the responses to the same place the
+-- requests were issued.
+runRequesterT :: (Reflex t, Monad m)
+              => RequesterT t request response m a
+              -> Event t (RequesterData response) --TODO: This DMap will be in reverse order, so we need to make sure the caller traverses it in reverse
+              -> m (a, Event t (RequesterData request)) --TODO: we need to hide these 'MyTag's here, because they're unsafe to mix in the wild
+runRequesterT (RequesterT a) responses = do
+  (result, s) <- runReaderT (runStateT a $ RequesterState (-4) []) $ fanInt $
+    coerceEvent responses
+  return (result, fmapCheap (RequesterData . TagMap) $ mergeInt $ IntMap.fromDistinctAscList $ _requesterState_requests s)
+
+-- | Map a function over the request and response of a 'RequesterT'
+withRequesterT
+  :: (Reflex t, MonadFix m)
+  => (forall x. req x -> req' x) -- ^ The function to map over the request
+  -> (forall x. rsp' x -> rsp x) -- ^ The function to map over the response
+  -> RequesterT t req rsp m a -- ^ The internal 'RequesterT' whose input and output will be transformed
+  -> RequesterT t req' rsp' m a -- ^ The resulting 'RequesterT'
+withRequesterT freq frsp child = do
+  rec let rsp = fmap (runIdentity . traverseRequesterData (Identity . frsp)) rsp'
+      (a, req) <- lift $ runRequesterT child rsp
+      rsp' <- fmap (flip selectInt 0 . fanInt . fmapCheap unMultiEntry) $ requesting' $
+        fmapCheap (multiEntry . IntMap.singleton 0) $ fmap (runIdentity . traverseRequesterData (Identity . freq)) req
+  return a
+
+instance (Reflex t, Monad m) => Requester t (RequesterT t request response m) where
+  type Request (RequesterT t request response m) = request
+  type Response (RequesterT t request response m) = response
+  requesting = fmap coerceEvent . responseFromTag . castMyTagWrap <=< tagRequest . (coerceEvent :: Event t (request a) -> Event t (Entry request (Single a)))
+  requesting_ = void . tagRequest . fmapCheap singleEntry
+
+{-# INLINE tagRequest #-}
+tagRequest :: forall m x t request response. (Monad m, MyTagTypeOffset x) => Event t (Entry request x) -> RequesterT t request response m (MyTagWrap request (Entry request x))
+tagRequest req = do
+  old <- RequesterT get
+  let n = _requesterState_nextMyTag old .|. myTagTypeOffset (Proxy :: Proxy x)
+      t = MyTagWrap n
+  RequesterT $ put $ RequesterState
+    { _requesterState_nextMyTag = _requesterState_nextMyTag old - 0x4
+    , _requesterState_requests = (n, (unsafeCoerce :: Event t (Entry request x) -> Event t Any) req) : _requesterState_requests old
+    }
+  return t
+
+{-# INLINE responseFromTag #-}
+responseFromTag :: Monad m => MyTagWrap response (Entry response x) -> RequesterT t request response m (Event t (Entry response x))
+responseFromTag (MyTagWrap t) = do
+  responses :: EventSelectorInt t Any <- RequesterT ask
+  return $ (unsafeCoerce :: Event t Any -> Event t (Entry response x)) $ selectInt responses t
+
+instance MonadTrans (RequesterT t request response) where
+  lift = RequesterT . lift . lift
+
+instance PerformEvent t m => PerformEvent t (RequesterT t request response m) where
+  type Performable (RequesterT t request response m) = Performable m
+  performEvent_ = lift . performEvent_
+  performEvent = lift . performEvent
+
+instance MonadRef m => MonadRef (RequesterT t request response m) where
+  type Ref (RequesterT t request response m) = Ref m
+  newRef = lift . newRef
+  readRef = lift . readRef
+  writeRef r = lift . writeRef r
+
+instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (RequesterT t request response m) where
+  newEventWithTrigger = lift . newEventWithTrigger
+  newFanEventWithTrigger f = lift $ newFanEventWithTrigger f
+
+instance MonadReader r m => MonadReader r (RequesterT t request response m) where
+  ask = lift ask
+  local f (RequesterT a) = RequesterT $ mapStateT (mapReaderT $ local f) a
+  reader = lift . reader
+
+instance (Reflex t, Adjustable t m, MonadHold t m, MonadFix m) => Adjustable t (RequesterT t request response m) where
+  runWithReplace = runWithReplaceRequesterTWith $ \dm0 dm' -> lift $ runWithReplace dm0 dm'
+  traverseIntMapWithKeyWithAdjust = traverseIntMapWithKeyWithAdjustRequesterTWith (\f dm0 dm' -> lift $ traverseIntMapWithKeyWithAdjust f dm0 dm') patchIntMapNewElementsMap mergeIntIncremental
+  {-# INLINABLE traverseDMapWithKeyWithAdjust #-}
+  traverseDMapWithKeyWithAdjust = traverseDMapWithKeyWithAdjustRequesterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjust f dm0 dm') mapPatchDMap weakenPatchDMapWith patchMapNewElementsMap mergeMapIncremental
+  traverseDMapWithKeyWithAdjustWithMove = traverseDMapWithKeyWithAdjustRequesterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjustWithMove f dm0 dm') mapPatchDMapWithMove weakenPatchDMapWithMoveWith patchMapWithMoveNewElementsMap mergeMapIncrementalWithMove
+
+requesting' :: (MyTagTypeOffset x, Monad m) => Event t (Entry request x) -> RequesterT t request response m (Event t (Entry response x))
+requesting' = responseFromTag . castMyTagWrap <=< tagRequest
+
+{-# INLINABLE runWithReplaceRequesterTWith #-}
+runWithReplaceRequesterTWith :: forall m t request response a b. (Reflex t, MonadHold t m
+                                                                 , MonadFix m
+                                                                 )
+                             => (forall a' b'. m a' -> Event t (m b') -> RequesterT t request response m (a', Event t b'))
+                             -> RequesterT t request response m a
+                             -> Event t (RequesterT t request response m b)
+                             -> RequesterT t request response m (a, Event t b)
+runWithReplaceRequesterTWith f a0 a' = do
+  rec na' <- numberOccurrencesFrom 1 a'
+      responses <- fmap (fmapCheap unMultiEntry) $ requesting' $ fmapCheap multiEntry $ switchPromptlyDyn requests --TODO: Investigate whether we can really get rid of the prompt stuff here
+      let responses' = fanInt responses
+      ((result0, requests0), v') <- f (runRequesterT a0 (selectInt responses' 0)) $ fmapCheap (\(n, a) -> fmap ((,) n) $ runRequesterT a $ selectInt responses' n) na'
+      requests <- holdDyn (fmapCheap (IntMap.singleton 0) requests0) $ fmapCheap (\(n, (_, reqs)) -> fmapCheap (IntMap.singleton n) reqs) v'
+  return (result0, fmapCheap (fst . snd) v')
+
+{-# INLINE traverseIntMapWithKeyWithAdjustRequesterTWith #-}
+traverseIntMapWithKeyWithAdjustRequesterTWith :: forall t request response m v v' p.
+                                        ( Reflex t
+                                        , MonadHold t m
+                                        , PatchTarget (p (Event t (IntMap (RequesterData request)))) ~ IntMap (Event t (IntMap (RequesterData request)))
+                                        , Patch (p (Event t (IntMap (RequesterData request))))
+                                        , Functor p
+                                        , MonadFix m
+                                        )
+                                     => (   (IntMap.Key -> (IntMap.Key, v) -> m (Event t (IntMap (RequesterData request)), v'))
+                                         -> IntMap (IntMap.Key, v)
+                                         -> Event t (p (IntMap.Key, v))
+                                         -> RequesterT t request response m (IntMap (Event t (IntMap (RequesterData request)), v'), Event t (p (Event t (IntMap (RequesterData request)), v')))
+                                        )
+                                     -> (p (Event t (IntMap (RequesterData request))) -> IntMap (Event t (IntMap (RequesterData request))))
+                                     -> (Incremental t (p (Event t (IntMap (RequesterData request)))) -> Event t (IntMap (IntMap (RequesterData request))))
+                                     -> (IntMap.Key -> v -> RequesterT t request response m v')
+                                     -> IntMap v
+                                     -> Event t (p v)
+                                     -> RequesterT t request response m (IntMap v', Event t (p v'))
+traverseIntMapWithKeyWithAdjustRequesterTWith base patchNewElements mergePatchIncremental f dm0 dm' = do
+  rec response <- requesting' $ fmapCheap pack $ promptRequests `mappend` mergePatchIncremental requests --TODO: Investigate whether we can really get rid of the prompt stuff here
+      let responses :: EventSelectorInt t (IntMap (RequesterData response))
+          responses = fanInt $ fmapCheap unpack response
+          unpack :: Entry response Multi3 -> IntMap (IntMap (RequesterData response))
+          unpack = unEntry
+          pack :: IntMap (IntMap (RequesterData request)) -> Entry request Multi3
+          pack = Entry
+          f' :: IntMap.Key -> (Int, v) -> m (Event t (IntMap (RequesterData request)), v')
+          f' k (n, v) = do
+            (result, myRequests) <- runRequesterT (f k v) $ mapMaybeCheap (IntMap.lookup n) $ selectInt responses k --TODO: Instead of doing mapMaybeCheap, can we share a fanInt across all instances of a given key, or at least the ones that are adjacent in time?
+            return (fmapCheap (IntMap.singleton n) myRequests, result)
+      ndm' <- numberOccurrencesFrom 1 dm'
+      (children0, children') <- base f' (fmap ((,) 0) dm0) $ fmap (\(n, dm) -> fmap ((,) n) dm) ndm' --TODO: Avoid this somehow, probably by adding some sort of per-cohort information passing to Adjustable
+      let result0 = fmap snd children0
+          result' = fforCheap children' $ fmap snd
+          requests0 :: IntMap (Event t (IntMap (RequesterData request)))
+          requests0 = fmap fst children0
+          requests' :: Event t (p (Event t (IntMap (RequesterData request))))
+          requests' = fforCheap children' $ fmap fst
+          promptRequests :: Event t (IntMap (IntMap (RequesterData request)))
+          promptRequests = coincidence $ fmapCheap (mergeInt . patchNewElements) requests' --TODO: Create a mergeIncrementalPromptly, and use that to eliminate this 'coincidence'
+      requests <- holdIncremental requests0 requests'
+  return (result0, result')
+
+{-# INLINE traverseDMapWithKeyWithAdjustRequesterTWith #-}
+traverseDMapWithKeyWithAdjustRequesterTWith :: forall k t request response m v v' p p'.
+                                        ( GCompare k
+                                        , Reflex t
+                                        , MonadHold t m
+                                        , PatchTarget (p' (Some k) (Event t (IntMap (RequesterData request)))) ~ Map (Some k) (Event t (IntMap (RequesterData request)))
+                                        , Patch (p' (Some k) (Event t (IntMap (RequesterData request))))
+                                        , MonadFix m
+                                        )
+                                     => (forall k' v1 v2. GCompare k'
+                                         => (forall a. k' a -> v1 a -> m (v2 a))
+                                         -> DMap k' v1
+                                         -> Event t (p k' v1)
+                                         -> RequesterT t request response m (DMap k' v2, Event t (p k' v2))
+                                        )
+                                     -> (forall v1 v2. (forall a. v1 a -> v2 a) -> p k v1 -> p k v2)
+                                     -> (forall v1 v2. (forall a. v1 a -> v2) -> p k v1 -> p' (Some k) v2)
+                                     -> (forall v2. p' (Some k) v2 -> Map (Some k) v2)
+                                     -> (forall a. Incremental t (p' (Some k) (Event t a)) -> Event t (Map (Some k) a))
+                                     -> (forall a. k a -> v a -> RequesterT t request response m (v' a))
+                                     -> DMap k v
+                                     -> Event t (p k v)
+                                     -> RequesterT t request response m (DMap k v', Event t (p k v'))
+traverseDMapWithKeyWithAdjustRequesterTWith base mapPatch weakenPatchWith patchNewElements mergePatchIncremental f dm0 dm' = do
+  rec response <- requesting' $ fmapCheap pack $ promptRequests `mappend` mergePatchIncremental requests --TODO: Investigate whether we can really get rid of the prompt stuff here
+      let responses :: EventSelector t (Const2 (Some k) (IntMap (RequesterData response)))
+          responses = fanMap $ fmapCheap unpack response
+          unpack :: Entry response (Multi2 k) -> Map (Some k) (IntMap (RequesterData response))
+          unpack = unEntry
+          pack :: Map (Some k) (IntMap (RequesterData request)) -> Entry request (Multi2 k)
+          pack = Entry
+          f' :: forall a. k a -> Compose ((,) Int) v a -> m (Compose ((,) (Event t (IntMap (RequesterData request)))) v' a)
+          f' k (Compose (n, v)) = do
+            (result, myRequests) <- runRequesterT (f k v) $ mapMaybeCheap (IntMap.lookup n) $ select responses (Const2 (Some k))
+            return $ Compose (fmapCheap (IntMap.singleton n) myRequests, result)
+      ndm' <- numberOccurrencesFrom 1 dm'
+      (children0, children') <- base f' (DMap.map (\v -> Compose (0, v)) dm0) $ fmap (\(n, dm) -> mapPatch (\v -> Compose (n, v)) dm) ndm'
+      let result0 = DMap.map (snd . getCompose) children0
+          result' = fforCheap children' $ mapPatch $ snd . getCompose
+          requests0 :: Map (Some k) (Event t (IntMap (RequesterData request)))
+          requests0 = weakenDMapWith (fst . getCompose) children0
+          requests' :: Event t (p' (Some k) (Event t (IntMap (RequesterData request))))
+          requests' = fforCheap children' $ weakenPatchWith $ fst . getCompose
+          promptRequests :: Event t (Map (Some k) (IntMap (RequesterData request)))
+          promptRequests = coincidence $ fmapCheap (mergeMap . patchNewElements) requests' --TODO: Create a mergeIncrementalPromptly, and use that to eliminate this 'coincidence'
+      requests <- holdIncremental requests0 requests'
+  return (result0, result')
+
+data Decoder rawResponse response =
+  forall a. Decoder (RequesterDataKey a) (rawResponse -> response a)
+
+-- | Matches incoming responses with previously-sent requests
+-- and uses the provided request "decoder" function to process
+-- incoming responses.
+matchResponsesWithRequests
+  :: forall t rawRequest rawResponse request response m.
+     ( MonadFix m
+     , MonadHold t m
+     , Reflex t
+     )
+  => (forall a. request a -> (rawRequest, rawResponse -> response a))
+  -- ^ Given a request (from 'Requester'), produces the wire format of the
+  -- request and a function used to process the associated response
+  -> Event t (RequesterData request)
+  -- ^ The outgoing requests
+  -> Event t (Int, rawResponse)
+  -- ^ The incoming responses, tagged by an identifying key
+  -> m ( Event t (Map Int rawRequest)
+       , Event t (RequesterData response)
+       )
+  -- ^ A map of outgoing wire-format requests and an event of responses keyed
+  -- by the 'RequesterData' key of the associated outgoing request
+matchResponsesWithRequests f send recv = do
+  rec nextId <- hold 1 $ fmap (\(next, _, _) -> next) outgoing
+      waitingFor :: Incremental t (PatchMap Int (Decoder rawResponse response)) <-
+        holdIncremental mempty $ leftmost
+          [ fmap (\(_, outstanding, _) -> outstanding) outgoing
+          , snd <$> incoming
+          ]
+      let outgoing = processOutgoing nextId send
+          incoming = processIncoming waitingFor recv
+  return (fmap (\(_, _, rawReqs) -> rawReqs) outgoing, fst <$> incoming)
+  where
+    -- Tags each outgoing request with an identifying integer key
+    -- and returns the next available key, a map of response decoders
+    -- for requests for which there are outstanding responses, and the
+    -- raw requests to be sent out.
+    processOutgoing
+      :: Behavior t Int
+      -- The next available key
+      -> Event t (RequesterData request)
+      -- The outgoing request
+      -> Event t ( Int
+                 , PatchMap Int (Decoder rawResponse response)
+                 , Map Int rawRequest )
+      -- The new next-available-key, a map of requests expecting responses, and the tagged raw requests
+    processOutgoing nextId out = flip pushAlways out $ \dm -> do
+      oldNextId <- sample nextId
+      let (result, newNextId) = flip runState oldNextId $ forM (requesterDataToList dm) $ \(k :=> v) -> do
+            n <- get
+            put $ succ n
+            let (rawReq, rspF) = f v
+            return (n, rawReq, Decoder k rspF)
+          patchWaitingFor = PatchMap $ Map.fromList $
+            (\(n, _, dec) -> (n, Just dec)) <$> result
+          toSend = Map.fromList $ (\(n, rawReq, _) -> (n, rawReq)) <$> result
+      return (newNextId, patchWaitingFor, toSend)
+    -- Looks up the each incoming raw response in a map of response
+    -- decoders and returns the decoded response and a patch that can
+    -- be used to clear the ID of the consumed response out of the queue
+    -- of expected responses.
+    processIncoming
+      :: Incremental t (PatchMap Int (Decoder rawResponse response))
+      -- A map of outstanding expected responses
+      -> Event t (Int, rawResponse)
+      -- A incoming response paired with its identifying key
+      -> Event t (RequesterData response, PatchMap Int v)
+      -- The decoded response and a patch that clears the outstanding responses queue
+    processIncoming waitingFor inc = flip push inc $ \(n, rawRsp) -> do
+      wf <- sample $ currentIncremental waitingFor
+      case Map.lookup n wf of
+        Nothing -> return Nothing -- TODO How should lookup failures be handled here? They shouldn't ever happen..
+        Just (Decoder k rspF) -> do
+          let rsp = rspF rawRsp
+          return $ Just
+            ( singletonRequesterData k rsp
+            , PatchMap $ Map.singleton n Nothing
+            )
+-}

From 3c419d925f4387765225a01c5ed16d44d0d0fecc Mon Sep 17 00:00:00 2001
From: Ryan Trinkle <ryan.trinkle@gmail.com>
Date: Thu, 19 Sep 2019 13:16:15 -0400
Subject: [PATCH 03/34] Still WIP, but seems to be working

---
 default.nix                           |  43 ----------
 reflex.cabal                          |  14 ++-
 src/Data/TagMap.hs                    |   4 +
 src/Data/Unique/Tag/Local/Internal.hs |  10 ++-
 src/Reflex/Dynamic.hs                 |   1 +
 src/Reflex/EventWriter/Base.hs        |   3 +
 src/Reflex/NotReady/Class.hs          |   5 ++
 src/Reflex/Patch/IntMap.hs            |  27 ++++--
 src/Reflex/PerformEvent/Base.hs       | 117 +++++++++++++++++---------
 src/Reflex/Requester/Base.hs          |   5 +-
 src/Reflex/Requester/Base/Internal.hs |  52 ++++++++++--
 src/Reflex/Spider/Internal.hs         |   5 +-
 test/EventWriterT.hs                  |  26 +++---
 test/RequesterT.hs                    |  57 +++++++------
 14 files changed, 229 insertions(+), 140 deletions(-)
 delete mode 100644 default.nix

diff --git a/default.nix b/default.nix
deleted file mode 100644
index 1a514db5..00000000
--- a/default.nix
+++ /dev/null
@@ -1,43 +0,0 @@
-{ mkDerivation, ghc, base, bifunctors, containers, deepseq
-, dependent-map, dependent-sum, exception-transformers
-, haskell-src-exts, haskell-src-meta, hlint, lens, MemoTrie
-, monad-control, mtl, primitive, random, ref-tf
-, semigroupoids , semigroups, split, stdenv, stm, syb
-, template-haskell , these, time, transformers
-, transformers-compat, unbounded-delays, prim-uniq
-, data-default, filepath, directory, filemanip, ghcjs-base
-, monoidal-containers, witherable, profunctors
-, semialign ? null, splitThese ? (semialign != null)
-, useTemplateHaskell ? true
-}:
-mkDerivation {
-  pname = "reflex";
-  version = "0.6.2.4";
-  src = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [ ".git" "dist" ])) ./.;
-  libraryHaskellDepends = [
-    base bifunctors containers dependent-map dependent-sum
-    exception-transformers lens
-    MemoTrie monad-control mtl primitive ref-tf semigroupoids
-    semigroups stm syb template-haskell these transformers
-    transformers-compat prim-uniq
-    base bifunctors containers deepseq dependent-map dependent-sum
-    mtl ref-tf split transformers data-default
-    random time unbounded-delays monoidal-containers witherable
-    profunctors
-  ] ++ (if ghc.isGhcjs or false then [
-    ghcjs-base
-  ] else []) ++ (if !useTemplateHaskell then [] else [
-    haskell-src-exts haskell-src-meta
-  ]) ++ (if splitThese then [
-    semialign
-  ] else []);
-  testHaskellDepends = if ghc.isGhcjs or false then [] else [
-    hlint filepath directory filemanip
-  ];
-  configureFlags =
-    stdenv.lib.optional (!useTemplateHaskell) [ "-f-use-template-haskell" ] ++
-    stdenv.lib.optional (!splitThese) [ "-f-split-these" ];
-  homepage = "https://github.com/reflex-frp/reflex";
-  description = "Higher-order Functional Reactive Programming";
-  license = stdenv.lib.licenses.bsd3;
-}
diff --git a/reflex.cabal b/reflex.cabal
index 62a87752..8779a9a9 100644
--- a/reflex.cabal
+++ b/reflex.cabal
@@ -92,12 +92,15 @@ library
     Data.FastWeakBag,
     Data.Functor.Misc,
     Data.Map.Misc,
+    Data.TagMap,
+    Data.Unique.Tag.Local,
+    Data.Unique.Tag.Local.Internal,
     Data.WeakBag,
     Reflex,
-    Reflex.Class,
     Reflex.Adjustable.Class,
     Reflex.BehaviorWriter.Base,
     Reflex.BehaviorWriter.Class,
+    Reflex.Class,
     Reflex.Collection,
     Reflex.Dynamic,
     Reflex.Dynamic.Uniq,
@@ -107,6 +110,7 @@ library
     Reflex.EventWriter,
     Reflex.EventWriter.Base,
     Reflex.EventWriter.Class,
+    Reflex.FanTag,
     Reflex.FastWeak,
     Reflex.FunctorMaybe,
     Reflex.Host.Class,
@@ -128,6 +132,7 @@ library
     Reflex.Query.Base,
     Reflex.Query.Class,
     Reflex.Requester.Base,
+    Reflex.Requester.Base.Internal,
     Reflex.Requester.Class,
     Reflex.Spider,
     Reflex.Spider.Internal,
@@ -260,14 +265,15 @@ test-suite RequesterT
   build-depends: base
                , containers
                , deepseq
-               , dependent-sum
                , dependent-map
+               , dependent-sum
                , lens
                , mtl
+               , primitive
+               , ref-tf
+               , reflex
                , these
                , transformers
-               , reflex
-               , ref-tf
 
   if flag(split-these)
     build-depends: these-lens
diff --git a/src/Data/TagMap.hs b/src/Data/TagMap.hs
index 06873c69..fef9bf37 100644
--- a/src/Data/TagMap.hs
+++ b/src/Data/TagMap.hs
@@ -7,6 +7,7 @@ module Data.TagMap
   , toDMap
   , fromList
   , insert
+  , size
   ) where
 
 import Data.IntMap (IntMap)
@@ -33,3 +34,6 @@ insert k v = TagMap . IntMap.insert (tagId k) ((unsafeCoerce :: v a -> Any) v) .
 
 fromList :: [DSum (Tag x) v] -> TagMap x v
 fromList = TagMap . IntMap.fromList . fmap (\(t :=> v) -> (tagId t, (unsafeCoerce :: v a -> Any) v))
+
+size :: TagMap x v -> Int
+size = IntMap.size . unTagMap
diff --git a/src/Data/Unique/Tag/Local/Internal.hs b/src/Data/Unique/Tag/Local/Internal.hs
index 7d4e1550..3164fe64 100644
--- a/src/Data/Unique/Tag/Local/Internal.hs
+++ b/src/Data/Unique/Tag/Local/Internal.hs
@@ -9,6 +9,7 @@
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE MagicHash #-}
 module Data.Unique.Tag.Local.Internal where
 
 import Control.Monad.Exception
@@ -17,6 +18,8 @@ import Control.Monad.Reader
 import Data.Primitive.MutVar
 import Data.GADT.Compare
 import Data.Some
+import GHC.Exts (Int (..), Int#, MutVar#, unsafeCoerce#)
+
 import Unsafe.Coerce
 
 newtype Tag x a = Tag Int
@@ -33,11 +36,14 @@ unsafeTagFromId n = Tag n
 -- We use Int because it is supported by e.g. IntMap
 newtype TagGen ps s = TagGen { unTagGen :: MutVar ps Int }
 
+instance Show (TagGen ps s) where
+  show (TagGen (MutVar m)) = show $ I# ((unsafeCoerce# :: MutVar# ps Int -> Int#) m)
+
 instance GEq (TagGen ps) where
   TagGen a `geq` TagGen b =
     if a == b
-    then Nothing
-    else Just $ unsafeCoerce Refl
+    then Just $ unsafeCoerce Refl
+    else Nothing
 
 newTag :: PrimMonad m => TagGen (PrimState m) s -> m (Tag s a)
 newTag (TagGen r) = do
diff --git a/src/Reflex/Dynamic.hs b/src/Reflex/Dynamic.hs
index ba92d829..0a516b9a 100644
--- a/src/Reflex/Dynamic.hs
+++ b/src/Reflex/Dynamic.hs
@@ -191,6 +191,7 @@ switchPromptlyDyn de =
   let eLag = switch $ current de
       eCoincidences = coincidence $ updated de
   in leftmost [eCoincidences, eLag]
+--TODO: switchPromptlyDyn should get the `only` treatment like switchHoldPromptOnly
 
 -- | Split a 'Dynamic' pair into a pair of 'Dynamic's
 splitDynPure :: Reflex t => Dynamic t (a, b) -> (Dynamic t a, Dynamic t b)
diff --git a/src/Reflex/EventWriter/Base.hs b/src/Reflex/EventWriter/Base.hs
index 517af0db..83a4397f 100644
--- a/src/Reflex/EventWriter/Base.hs
+++ b/src/Reflex/EventWriter/Base.hs
@@ -200,6 +200,9 @@ sequenceIntMapWithAdjustEventWriterTWith base mergePatchIncremental coincidenceP
       h : t -> Just $ sconcat $ h :| t
   return (result0, result')
 
+switchHoldPromptOnlyIntMapIncremental :: (Reflex t, MonadHold t m) => IntMap (Event t a) -> Event t (PatchIntMap (Event t a)) -> m (Event t (IntMap a))
+switchHoldPromptOnlyIntMapIncremental = switchHoldPromptOnlyIncremental mergeIntIncremental coincidencePatchIntMap
+
 -- | Like 'runWithReplaceEventWriterTWith', but for 'sequenceDMapWithAdjust'.
 sequenceDMapWithAdjustEventWriterTWith
   :: forall t m p p' w k v v'
diff --git a/src/Reflex/NotReady/Class.hs b/src/Reflex/NotReady/Class.hs
index 7d1232bd..44f42592 100644
--- a/src/Reflex/NotReady/Class.hs
+++ b/src/Reflex/NotReady/Class.hs
@@ -25,6 +25,7 @@ import Reflex.PerformEvent.Base (PerformEventT (..))
 import Reflex.PostBuild.Base (PostBuildT)
 import Reflex.Query.Base (QueryT)
 import Reflex.Requester.Base (RequesterT)
+import Reflex.Requester.Base.Internal (RequesterInternalT)
 import Reflex.TriggerEvent.Base (TriggerEventT)
 
 class Monad m => NotReady t m | m -> t where
@@ -72,6 +73,10 @@ instance NotReady t m => NotReady t (RequesterT t request response m) where
   notReadyUntil = lift . notReadyUntil
   notReady = lift notReady
 
+instance NotReady t m => NotReady t (RequesterInternalT s t request response m) where
+  notReadyUntil = lift . notReadyUntil
+  notReady = lift notReady
+
 instance NotReady t m => NotReady t (TriggerEventT t m) where
   notReadyUntil = lift . notReadyUntil
   notReady = lift notReady
diff --git a/src/Reflex/Patch/IntMap.hs b/src/Reflex/Patch/IntMap.hs
index 3aba432f..0e3a45fc 100644
--- a/src/Reflex/Patch/IntMap.hs
+++ b/src/Reflex/Patch/IntMap.hs
@@ -1,12 +1,16 @@
 {-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 -- | Module containing 'PatchIntMap', a 'Patch' for 'IntMap' which allows for
 -- insert/update or delete of associations.
 module Reflex.Patch.IntMap where
 
+import Control.Lens
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IntMap
 import Data.Maybe
@@ -18,14 +22,6 @@ import Reflex.Patch.Class
 -- 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.
@@ -34,11 +30,26 @@ instance Semigroup (PatchIntMap v) where
   -- PatchMap is idempotent, so stimes n is id for every n
   stimes = stimesIdempotentMonoid
 
+makeWrapped ''PatchIntMap
+
+-- | 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
+
 -- | 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
 
+instance FunctorWithIndex Int PatchIntMap
+instance FoldableWithIndex Int PatchIntMap
+instance TraversableWithIndex Int PatchIntMap where
+  itraversed = _Wrapped . itraversed . traversed
+
 -- | 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)
diff --git a/src/Reflex/PerformEvent/Base.hs b/src/Reflex/PerformEvent/Base.hs
index 07e3043e..88c5f6f8 100644
--- a/src/Reflex/PerformEvent/Base.hs
+++ b/src/Reflex/PerformEvent/Base.hs
@@ -30,6 +30,8 @@ import Reflex.Host.Class
 import Reflex.PerformEvent.Class
 import Reflex.Requester.Base.Internal
 import Reflex.Requester.Class
+import Reflex.EventWriter.Class
+import Reflex.EventWriter.Base
 
 import Control.Lens
 import Control.Monad.Exception
@@ -37,13 +39,21 @@ import Control.Monad.Identity
 import Control.Monad.Primitive
 import Control.Monad.Reader
 import Control.Monad.Ref
-import Data.Coerce
 import Data.Dependent.Map (DMap)
 import qualified Data.Dependent.Map as DMap
 import Data.Dependent.Sum
+import Data.Foldable
+import Data.Functor.Compose
+import Data.Functor.Misc
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IntMap
 import qualified Data.Semigroup as S
+import Data.Unique.Tag.Local
+import Data.Sequence (Seq)
+import Data.Tuple
+import qualified Data.TagMap as TagMap
+
+import Debug.Trace
 
 -- | A function that fires events for the given 'EventTrigger's and then runs
 -- any followup actions provided via 'PerformEvent'.  The given 'ReadPhase'
@@ -75,41 +85,61 @@ instance (ReflexHost t, Ref m ~ Ref IO, PrimMonad (HostFrame t)) => PerformEvent
   {-# INLINABLE performEvent #-}
   performEvent = PerformEventT . requestingIdentity
 
--- | An Adjustable instance where "adjusting" just runs the new thing - nothing is done with the old thing
-newtype NullAdjustable t m a = NullAdjustable { unNullAdjustable :: m a }
-  deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException)
-
-instance PrimMonad m => PrimMonad (NullAdjustable t m) where
-  type PrimState (NullAdjustable t m) = PrimState m
-
-instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT t m) where
-  runWithReplace (PerformEventT (RequesterT a0)) a' = PerformEventT $ RequesterT $ do
-    (s, tg) <- RequesterInternalT ask
-    newA <- requestingIdentity $ undefined <$> a'
-    runWithReplace a0 never
-
-instance Adjustable t (NullAdjustable t m) where
-  runWithReplace a0 a' = NullAdjustable $ do
-    return (result0, result')
-  traverseDMapWithKeyWithAdjust = defaultAdjustBase traversePatchDMapWithKey
-  traverseDMapWithKeyWithAdjustWithMove = defaultAdjustBase traversePatchDMapWithMoveWithKey
-
-{-
-  traverseIntMapWithKeyWithAdjust = defaultAdjustIntBase traverseIntMapPatchWithKey
--}
-
-{-
 instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT t m) where
-  runWithReplace outerA0 outerA' = PerformEventT $ runWithReplaceRequesterTWith f (coerce outerA0) (coerceEvent outerA')
-    where f :: HostFrame t a -> Event t (HostFrame t b) -> RequesterT t (HostFrame t) Identity (HostFrame t) (a, Event t b)
-          f a0 a' = do
-            result0 <- lift a0
-            result' <- requestingIdentity a'
-            return (result0, result')
-  traverseIntMapWithKeyWithAdjust f outerDm0 outerDm' = PerformEventT $ traverseIntMapWithKeyWithAdjustRequesterTWith (defaultAdjustIntBase traverseIntMapPatchWithKey) patchIntMapNewElementsMap mergeIntIncremental (\k v -> unPerformEventT $ f k v) (coerce outerDm0) (coerceEvent outerDm')
-  traverseDMapWithKeyWithAdjust f outerDm0 outerDm' = PerformEventT $ traverseDMapWithKeyWithAdjustRequesterTWith (defaultAdjustBase traversePatchDMapWithKey) mapPatchDMap weakenPatchDMapWith patchMapNewElementsMap mergeMapIncremental (\k v -> unPerformEventT $ f k v) (coerce outerDm0) (coerceEvent outerDm')
-  traverseDMapWithKeyWithAdjustWithMove f outerDm0 outerDm' = PerformEventT $ traverseDMapWithKeyWithAdjustRequesterTWith (defaultAdjustBase traversePatchDMapWithMoveWithKey) mapPatchDMapWithMove weakenPatchDMapWithMoveWith patchMapWithMoveNewElementsMap mergeMapIncrementalWithMove (\k v -> unPerformEventT $ f k v) (coerce outerDm0) (coerceEvent outerDm')
--}
+  runWithReplace a0 a' = PerformEventT $ RequesterT $ do
+    env@(_, _ :: TagGen (PrimState (HostFrame t)) s) <- RequesterInternalT ask
+    let runA :: forall a. PerformEventT t m a -> HostFrame t (a, Event t (Seq (RequestEnvelope s (HostFrame t))))
+        runA (PerformEventT (RequesterT a)) = runEventWriterT $ runReaderT (unRequesterInternalT a) env
+    (result0, requests0) <- lift $ runA a0
+    newA <- requestingIdentity $ traceEventWith (const "running new widget") $ runA <$> a'
+    requests <- switchHoldPromptOnly requests0 $ traceEventWith (const "updating runWithReplace") $ fmapCheap snd newA
+    --TODO: promptly *prevent* events, then sign up the new ones; this is a serious breaking change to PerformEvent
+    RequesterInternalT $ tellEvent requests
+    pure (result0, fmapCheap fst newA)
+  traverseIntMapWithKeyWithAdjust f a0 a' = PerformEventT $ RequesterT $ do
+    env@(_, _ :: TagGen (PrimState (HostFrame t)) s) <- RequesterInternalT ask
+    let runA :: forall a. PerformEventT t m a -> HostFrame t (a, Event t (Seq (RequestEnvelope s (HostFrame t))))
+        runA (PerformEventT (RequesterT a)) = runEventWriterT $ runReaderT (unRequesterInternalT a) env
+    children' <- requestingIdentity $ itraverse (\k -> runA . f k) <$> a'
+    children0 <- lift $ itraverse (\k -> runA . f k) a0
+    let results0 = fmap fst children0
+        requests0 = fmap snd children0
+        results' = fmap fst <$> children'
+        requests' = fmap snd `fmapCheap` children'
+    requests <- switchHoldPromptOnlyIncremental mergeIntIncremental coincidencePatchIntMap requests0 $ requests'
+    --TODO: promptly *prevent* events, then sign up the new ones; this is a serious breaking change to PerformEvent
+    RequesterInternalT $ tellEvent $ fforMaybeCheap requests $ \m -> if null m then Nothing else Just $ fold m
+    pure (results0, results')
+  traverseDMapWithKeyWithAdjust (f :: forall a. k a -> v a -> PerformEventT t m (v' a)) (a0 :: DMap k v) a' = PerformEventT $ RequesterT $ do
+    env@(_, _ :: TagGen (PrimState (HostFrame t)) s) <- RequesterInternalT ask
+    let runA :: forall a. k a -> v a -> HostFrame t (Compose ((,) (Event t (Seq (RequestEnvelope s (HostFrame t))))) v' a)
+        runA k v = fmap (Compose . swap) $ runEventWriterT $ runReaderT (unRequesterInternalT a) env
+          where (PerformEventT (RequesterT a)) = f k v
+    children' <- requestingIdentity $ traversePatchDMapWithKey runA <$> a'
+    children0 <- lift $ DMap.traverseWithKey runA a0
+    let results0 = DMap.map (snd . getCompose) children0
+        requests0 = weakenDMapWith (fst . getCompose) children0
+        results' = mapPatchDMap (snd . getCompose) <$> children'
+        requests' = weakenPatchDMapWith (fst . getCompose) `fmapCheap` children'
+    requests <- switchHoldPromptOnlyIncremental mergeMapIncremental coincidencePatchMap requests0 $ requests'
+    --TODO: promptly *prevent* events, then sign up the new ones; this is a serious breaking change to PerformEvent
+    RequesterInternalT $ tellEvent $ fforMaybeCheap requests $ \m -> if null m then Nothing else Just $ fold m
+    pure (results0, results')
+  traverseDMapWithKeyWithAdjustWithMove (f :: forall a. k a -> v a -> PerformEventT t m (v' a)) (a0 :: DMap k v) a' = PerformEventT $ RequesterT $ do
+    env@(_, _ :: TagGen (PrimState (HostFrame t)) s) <- RequesterInternalT ask
+    let runA :: forall a. k a -> v a -> HostFrame t (Compose ((,) (Event t (Seq (RequestEnvelope s (HostFrame t))))) v' a)
+        runA k v = fmap (Compose . swap) $ runEventWriterT $ runReaderT (unRequesterInternalT a) env
+          where (PerformEventT (RequesterT a)) = f k v
+    children' <- requestingIdentity $ traversePatchDMapWithMoveWithKey runA <$> a'
+    children0 <- lift $ DMap.traverseWithKey runA a0
+    let results0 = DMap.map (snd . getCompose) children0
+        requests0 = weakenDMapWith (fst . getCompose) children0
+        results' = mapPatchDMapWithMove (snd . getCompose) <$> children'
+        requests' = weakenPatchDMapWithMoveWith (fst . getCompose) `fmapCheap` children'
+    requests <- switchHoldPromptOnlyIncremental mergeMapIncrementalWithMove coincidencePatchMapWithMove requests0 $ requests'
+    --TODO: promptly *prevent* events, then sign up the new ones; this is a serious breaking change to PerformEvent
+    RequesterInternalT $ tellEvent $ fforMaybeCheap requests $ \m -> if null m then Nothing else Just $ fold m
+    pure (results0, results')
 
 defaultAdjustBase :: forall t v v2 k' p. (Monad (HostFrame t), PrimMonad (HostFrame t), Reflex t)
   => ((forall a. k' a -> v a -> HostFrame t (v2 a)) -> p k' v -> HostFrame t (p k' v2))
@@ -155,8 +185,8 @@ hostPerformEventT :: forall t m a.
                   -> m (a, FireCommand t m)
 hostPerformEventT a = do
   (response, responseTrigger) <- newEventWithTriggerRef
-  (result, eventToPerform) <- runHostFrame $ runRequesterT (unPerformEventT a) response
-  eventToPerformHandle <- subscribeEvent eventToPerform
+  (result, eventToPerform) <- runHostFrame $ runRequesterT (unPerformEventT a) $ traceEventWith (const "response") response
+  eventToPerformHandle <- subscribeEvent $ traceEventWith (const "eventToPerform") eventToPerform
   return $ (,) result $ FireCommand $ \triggers (readPhase :: ReadPhase m a') -> do
     let go :: [DSum (EventTrigger t) Identity] -> m [a']
         go ts = do
@@ -167,11 +197,20 @@ hostPerformEventT a = do
           case mToPerform of
             Nothing -> return [result']
             Just toPerform -> do
+              traceM $ "toPerform: " <> case toPerform of
+                RequestData _ reqs -> show (length reqs)
               responses <- runHostFrame $ traverseRequesterData (Identity <$>) toPerform
+              let responseLength = case responses of
+                    ResponseData _ m -> TagMap.size m
+              traceM $ "responses: " <> show responseLength
               mrt <- readRef responseTrigger
               let followupEventTriggers = case mrt of
-                    Just rt -> [rt :=> Identity responses]
-                    Nothing -> []
+                    Just rt -> do
+                      traceM "a"
+                      [rt :=> Identity responses]
+                    Nothing -> do
+                      traceM "b"
+                      []
               (result':) <$> go followupEventTriggers
     go triggers
 
diff --git a/src/Reflex/Requester/Base.hs b/src/Reflex/Requester/Base.hs
index 5f461d79..bf71fab5 100644
--- a/src/Reflex/Requester/Base.hs
+++ b/src/Reflex/Requester/Base.hs
@@ -2,11 +2,14 @@
 -- 'Requester'.
 module Reflex.Requester.Base
   ( RequesterT (..)
+  , RequestData (..)
+  , ResponseData (..)
+  , RequestEnvelope (..)
   , runRequesterT
 --  , withRequesterT
 --  , RequesterData
 --  , RequesterDataKey
---  , traverseRequesterData
+  , traverseRequesterData
 --  , forRequesterData
 --  , requesterDataToList
 --  , singletonRequesterData
diff --git a/src/Reflex/Requester/Base/Internal.hs b/src/Reflex/Requester/Base/Internal.hs
index 9dbf0653..dc49b976 100644
--- a/src/Reflex/Requester/Base/Internal.hs
+++ b/src/Reflex/Requester/Base/Internal.hs
@@ -63,13 +63,21 @@ import Data.GADT.Compare
 import Data.Witherable
 import Data.Foldable
 
+import Debug.Trace
+
+--TODO: The use of Seq in this module could probably be replaced with something
+--even cheaper.  We do need O(1) append, but we don't need associativity until
+--the very end, when we're smashing everything together.  This could be
+--implemented as a binary tree whose representation isn't associative, but which
+--doesn't allow any external party to observe the lack of associativity.
+
 data RequestData ps request = forall s. RequestData !(TagGen ps s) !(Seq (RequestEnvelope s request))
 data ResponseData ps response = forall s. ResponseData !(TagGen ps s) !(TagMap s response)
 
 traverseRequesterData :: forall m request response. Applicative m => (forall a. request a -> m (response a)) -> RequestData (PrimState m) request -> m (ResponseData (PrimState m) response)
 traverseRequesterData f (RequestData tg es) = ResponseData tg . TagMap.fromList <$> wither g (toList es)
   where g (RequestEnvelope mt req) = case mt of
-          Just t -> (\rsp -> Just $ t :=> rsp) <$> f req
+          Just t -> Just . (t :=>) <$> f req
           Nothing -> Nothing <$ f req
 
 runRequesterT :: forall t request response m a
@@ -84,8 +92,8 @@ runRequesterT (RequesterT a) wrappedResponses = withRequesterInternalT $ \(reque
   (_, tg) <- RequesterInternalT ask
   result <- a
   let responses = fforMaybe wrappedResponses $ \(ResponseData tg' m) -> case tg `geq` tg' of
-        Nothing -> Nothing --TODO: Warn somehow
-        Just Refl -> Just m
+        Nothing -> trace ("runRequesterT: bad TagGen: expected " <> show tg <> " but got " <> show tg') Nothing --TODO: Warn somehow
+        Just Refl -> trace "runRequesterT: good TagGen" $ Just m
   pure (responses, (result, fmapCheap (RequestData tg) requests))
 
 instance MonadTrans (RequesterInternalT s t request response) where
@@ -140,13 +148,29 @@ instance MonadException m => MonadException (RequesterT t request respnose m) wh
   throw e = RequesterT $ throw e
 
 newtype RequesterInternalT s t request response m a = RequesterInternalT { unRequesterInternalT :: ReaderT (EventSelectorTag t s response, TagGen (PrimState m) s) (EventWriterT t (Seq (RequestEnvelope s request)) m) a }
-  deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException)
+  deriving
+    ( Functor, Applicative, Monad, MonadFix, MonadIO, MonadException
+#if MIN_VERSION_base(4,9,1)
+    , MonadAsyncException
+#endif
+    )
+
+-- I don't think this can actually be supported without an unsafeCoerce
+-- #if MIN_VERSION_base(4,9,1)
+-- instance MonadAsyncException m => MonadAsyncException (RequesterT t request response m) where
+--   mask f = RequesterT $ mask $ \unmask -> unRequesterT $ f $ \x -> RequesterT $ unmask $ unRequesterT x
+-- #endif
 
 instance MonadSample t m => MonadSample t (RequesterT t request response m)
 instance MonadHold t m => MonadHold t (RequesterT t request response m)
 instance PostBuild t m => PostBuild t (RequesterT t request response m)
 instance TriggerEvent t m => TriggerEvent t (RequesterT t request response m)
 
+instance MonadSample t m => MonadSample t (RequesterInternalT s t request response m)
+instance MonadHold t m => MonadHold t (RequesterInternalT s t request response m)
+instance PostBuild t m => PostBuild t (RequesterInternalT s t request response m)
+instance TriggerEvent t m => TriggerEvent t (RequesterInternalT s t request response m)
+
 instance PrimMonad m => PrimMonad (RequesterT t request response m) where
   type PrimState (RequesterT t request response m) = PrimState m
   primitive = lift . primitive
@@ -196,7 +220,25 @@ instance (Reflex t, PrimMonad m) => Requester t (RequesterInternalT s t request
   requesting_ e = RequesterInternalT $ do
     tellEvent $ fmapCheap (Seq.singleton . RequestEnvelope Nothing) e
 
-instance Adjustable t m => Adjustable t (RequesterInternalT s t request response m)
+instance (Adjustable t m, MonadHold t m) => Adjustable t (RequesterInternalT s t request response m) where
+  {-# INLINABLE runWithReplace #-}
+  runWithReplace (RequesterInternalT a0) a' = RequesterInternalT $ runWithReplace a0 (coerceEvent a')
+  {-# INLINABLE traverseIntMapWithKeyWithAdjust #-}
+  traverseIntMapWithKeyWithAdjust f dm0 dm' = RequesterInternalT $ traverseIntMapWithKeyWithAdjust (coerce . f) dm0 dm'
+  {-# INLINABLE traverseDMapWithKeyWithAdjust #-}
+  traverseDMapWithKeyWithAdjust f dm0 dm' = RequesterInternalT $ traverseDMapWithKeyWithAdjust (coerce . f) dm0 dm'
+  {-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}
+  traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = RequesterInternalT $ traverseDMapWithKeyWithAdjustWithMove (coerce . f) dm0 dm'
+
+instance (Adjustable t m, MonadHold t m) => Adjustable t (RequesterT t request response m) where
+  {-# INLINABLE runWithReplace #-}
+  runWithReplace (RequesterT a0) a' = RequesterT $ runWithReplace a0 (fmapCheap unRequesterT a')
+  {-# INLINABLE traverseIntMapWithKeyWithAdjust #-}
+  traverseIntMapWithKeyWithAdjust f dm0 dm' = RequesterT $ traverseIntMapWithKeyWithAdjust (\k v -> unRequesterT $ f k v) dm0 dm'
+  {-# INLINABLE traverseDMapWithKeyWithAdjust #-}
+  traverseDMapWithKeyWithAdjust f dm0 dm' = RequesterT $ traverseDMapWithKeyWithAdjust (\k v -> unRequesterT $ f k v) dm0 dm'
+  {-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}
+  traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = RequesterT $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unRequesterT $ f k v) dm0 dm'
 
 {-# INLINABLE runWithReplaceRequesterTWith #-}
 runWithReplaceRequesterTWith :: forall m t request response a b. (Reflex t, MonadHold t m
diff --git a/src/Reflex/Spider/Internal.hs b/src/Reflex/Spider/Internal.hs
index 90ceca78..21330760 100644
--- a/src/Reflex/Spider/Internal.hs
+++ b/src/Reflex/Spider/Internal.hs
@@ -106,6 +106,8 @@ import qualified Data.ByteString.Char8 as BS8
 import System.IO (stderr)
 #endif
 
+import Debug.Trace
+
 #ifdef DEBUG_TRACE_EVENTS
 
 withStackOneLine :: (BS8.ByteString -> a) -> a
@@ -1513,13 +1515,14 @@ newFanInt = do
 fanInt :: HasSpiderTimeline x => Event x (IntMap a) -> EventSelectorInt x a
 fanInt p = unsafePerformIO $ do
   self <- newFanInt
-  pure $ EventSelectorInt $ \k -> Event $ \sub -> do
+  pure $ EventSelectorInt $ \k -> trace ("select " <> show 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
         { subscriberPropagate = \m -> do
             liftIO $ writeIORef (_fanInt_occRef self) m
             scheduleIntClear $ _fanInt_occRef self
+            liftIO $ putStrLn $ "Pushing " <> show (IntMap.size m) <> " occurrences"
             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
                 subscriberPropagate s v
diff --git a/test/EventWriterT.hs b/test/EventWriterT.hs
index cd6c3146..2916d809 100644
--- a/test/EventWriterT.hs
+++ b/test/EventWriterT.hs
@@ -24,26 +24,30 @@ import Test.Run
 
 main :: IO ()
 main = do
-  os1@[[Just [10,9,8,7,6,5,4,3,2,1]]] <- runApp' (unwrapApp testOrdering) $
+  os1 <- runApp' (unwrapApp testOrdering) $
     [ Just ()
     ]
   print os1
-  os2@[[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]]
-    <- runApp' (unwrapApp testSimultaneous) $ map Just $
-         [ This ()
-         , That ()
-         , This ()
-         , These () ()
-         ]
+  os2 <- runApp' (unwrapApp testSimultaneous) $ map Just $
+    [ This ()
+    , That ()
+    , This ()
+    , These () ()
+    ]
   print os2
-  os3@[[Nothing, Just [2]]] <- runApp' (unwrapApp testMoribundTellEvent) [Just ()]
+  os3 <- runApp' (unwrapApp testMoribundTellEvent) [Just ()]
   print os3
-  os4@[[Nothing, Just [2]]] <- runApp' (unwrapApp testMoribundTellEventDMap) [Just ()]
+  os4 <- runApp' (unwrapApp testMoribundTellEventDMap) [Just ()]
   print os4
-  os5@[[Nothing, Just [1, 2]]] <- runApp' (unwrapApp testLiveTellEventDMap) [Just ()]
+  os5 <- runApp' (unwrapApp testLiveTellEventDMap) [Just ()]
   print os5
   os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
   print os6
+  let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1
+  let ![[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]] = os2
+  let ![[Nothing, Just [2]]] = os3
+  let ![[Nothing, Just [2]]] = os4
+  let ![[Nothing, Just [1, 2]]] = os5
   let ![[Nothing, Nothing]] = os6
   return ()
 
diff --git a/test/RequesterT.hs b/test/RequesterT.hs
index 3d61d58d..53bc12e2 100644
--- a/test/RequesterT.hs
+++ b/test/RequesterT.hs
@@ -10,11 +10,13 @@ module Main where
 import Control.Lens
 import Control.Monad
 import Control.Monad.Fix
+import Control.Monad.Primitive
 import qualified Data.Dependent.Map as DMap
 import Data.Dependent.Sum
 import Data.Functor.Misc
 import qualified Data.Map as M
 import Data.These
+import Data.Foldable
 
 #if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
 import Data.These.Lens
@@ -30,43 +32,46 @@ data RequestInt a where
 
 main :: IO ()
 main = do
-  os1 <- runApp' (unwrapApp testOrdering) $
-    [ Just ()
-    ]
-  print os1
-  os2 <- runApp' (unwrapApp testSimultaneous) $ map Just $
-    [ This ()
-    , That ()
-    , This ()
-    , These () ()
-    ]
-  print os2
-  os3 <- runApp' (unwrapApp testMoribundRequest) [Just ()]
-  print os3
+--  os1 <- runApp' (unwrapApp testOrdering) $
+--    [ Just ()
+--    ]
+--  print os1
+--  os2 <- runApp' (unwrapApp testSimultaneous) $ map Just $
+--    [ This ()
+--    , That ()
+--    , This ()
+--    , These () ()
+--    ]
+--  print os2
+--  os3 <- runApp' (unwrapApp testMoribundRequest) [Just ()]
+--  print os3
   os4 <- runApp' (unwrapApp testMoribundRequestDMap) [Just ()]
   print os4
-  os5 <- runApp' (unwrapApp testLiveRequestDMap) [Just ()]
-  print os5
-  os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
-  print os6
-  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
+--  os5 <- runApp' (unwrapApp testLiveRequestDMap) [Just ()]
+--  print os5
+--  os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
+--  print os6
+--  let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1
+--  let ![[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]] = os2
+--  let ![[Nothing, Just [2]]] = os3
   let ![[Nothing, Just [2]]] = os4
-  let ![[Nothing, Just [1, 2]]] = os5
+--  let ![[Nothing, Just [1, 2]]] = os5
   -- let ![[Nothing, Nothing]] = os6 -- TODO re-enable this test after issue #233 has been resolved
   return ()
 
-unwrapRequest :: DSum tag RequestInt -> Int
-unwrapRequest (_ :=> RequestInt i) = i
-
-unwrapApp :: ( Reflex t, Monad m )
+unwrapApp :: forall t m a.
+             ( Reflex t
+             , MonadFix m
+             , PrimMonad m
+             )
           => (a -> RequesterT t RequestInt Identity m ())
           -> a
           -> m (Event t [Int])
 unwrapApp x appIn = do
   ((), e) <- runRequesterT (x appIn) never
-  return $ fmap (map unwrapRequest . requesterDataToList) e
+  let unwrapRequests :: forall x. RequestData (PrimState m) RequestInt -> [Int]
+      unwrapRequests (RequestData _ es) = fmap (\(RequestEnvelope _ (RequestInt i)) -> i) $ toList es
+  return $ fmap unwrapRequests e
 
 testOrdering :: ( Response m ~ Identity
                 , Request m ~ RequestInt

From 06337b75911712b2a76ada378b842ad0a158eec5 Mon Sep 17 00:00:00 2001
From: Ryan Trinkle <ryan.trinkle@gmail.com>
Date: Fri, 20 Sep 2019 09:48:43 -0400
Subject: [PATCH 04/34] Eliminate some more traces

---
 src/Reflex/PerformEvent/Base.hs       | 17 ++++-------------
 src/Reflex/Requester/Base/Internal.hs |  2 +-
 src/Reflex/Spider/Internal.hs         |  5 +----
 3 files changed, 6 insertions(+), 18 deletions(-)

diff --git a/src/Reflex/PerformEvent/Base.hs b/src/Reflex/PerformEvent/Base.hs
index 88c5f6f8..e1f9c551 100644
--- a/src/Reflex/PerformEvent/Base.hs
+++ b/src/Reflex/PerformEvent/Base.hs
@@ -53,8 +53,6 @@ import Data.Sequence (Seq)
 import Data.Tuple
 import qualified Data.TagMap as TagMap
 
-import Debug.Trace
-
 -- | A function that fires events for the given 'EventTrigger's and then runs
 -- any followup actions provided via 'PerformEvent'.  The given 'ReadPhase'
 -- action will be run once for the initial trigger execution as well as once for
@@ -185,8 +183,8 @@ hostPerformEventT :: forall t m a.
                   -> m (a, FireCommand t m)
 hostPerformEventT a = do
   (response, responseTrigger) <- newEventWithTriggerRef
-  (result, eventToPerform) <- runHostFrame $ runRequesterT (unPerformEventT a) $ traceEventWith (const "response") response
-  eventToPerformHandle <- subscribeEvent $ traceEventWith (const "eventToPerform") eventToPerform
+  (result, eventToPerform) <- runHostFrame $ runRequesterT (unPerformEventT a) response
+  eventToPerformHandle <- subscribeEvent eventToPerform
   return $ (,) result $ FireCommand $ \triggers (readPhase :: ReadPhase m a') -> do
     let go :: [DSum (EventTrigger t) Identity] -> m [a']
         go ts = do
@@ -197,20 +195,13 @@ hostPerformEventT a = do
           case mToPerform of
             Nothing -> return [result']
             Just toPerform -> do
-              traceM $ "toPerform: " <> case toPerform of
-                RequestData _ reqs -> show (length reqs)
               responses <- runHostFrame $ traverseRequesterData (Identity <$>) toPerform
               let responseLength = case responses of
                     ResponseData _ m -> TagMap.size m
-              traceM $ "responses: " <> show responseLength
               mrt <- readRef responseTrigger
               let followupEventTriggers = case mrt of
-                    Just rt -> do
-                      traceM "a"
-                      [rt :=> Identity responses]
-                    Nothing -> do
-                      traceM "b"
-                      []
+                    Just rt -> [rt :=> Identity responses]
+                    Nothing -> []
               (result':) <$> go followupEventTriggers
     go triggers
 
diff --git a/src/Reflex/Requester/Base/Internal.hs b/src/Reflex/Requester/Base/Internal.hs
index dc49b976..53a424af 100644
--- a/src/Reflex/Requester/Base/Internal.hs
+++ b/src/Reflex/Requester/Base/Internal.hs
@@ -93,7 +93,7 @@ runRequesterT (RequesterT a) wrappedResponses = withRequesterInternalT $ \(reque
   result <- a
   let responses = fforMaybe wrappedResponses $ \(ResponseData tg' m) -> case tg `geq` tg' of
         Nothing -> trace ("runRequesterT: bad TagGen: expected " <> show tg <> " but got " <> show tg') Nothing --TODO: Warn somehow
-        Just Refl -> trace "runRequesterT: good TagGen" $ Just m
+        Just Refl -> Just m
   pure (responses, (result, fmapCheap (RequestData tg) requests))
 
 instance MonadTrans (RequesterInternalT s t request response) where
diff --git a/src/Reflex/Spider/Internal.hs b/src/Reflex/Spider/Internal.hs
index 21330760..90ceca78 100644
--- a/src/Reflex/Spider/Internal.hs
+++ b/src/Reflex/Spider/Internal.hs
@@ -106,8 +106,6 @@ import qualified Data.ByteString.Char8 as BS8
 import System.IO (stderr)
 #endif
 
-import Debug.Trace
-
 #ifdef DEBUG_TRACE_EVENTS
 
 withStackOneLine :: (BS8.ByteString -> a) -> a
@@ -1515,14 +1513,13 @@ newFanInt = do
 fanInt :: HasSpiderTimeline x => Event x (IntMap a) -> EventSelectorInt x a
 fanInt p = unsafePerformIO $ do
   self <- newFanInt
-  pure $ EventSelectorInt $ \k -> trace ("select " <> show k) $ Event $ \sub -> do
+  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
         { subscriberPropagate = \m -> do
             liftIO $ writeIORef (_fanInt_occRef self) m
             scheduleIntClear $ _fanInt_occRef self
-            liftIO $ putStrLn $ "Pushing " <> show (IntMap.size m) <> " occurrences"
             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
                 subscriberPropagate s v

From ee9c838fcddb31ffc67bcb79f827a9e1c87698fa Mon Sep 17 00:00:00 2001
From: Ryan Trinkle <ryan.trinkle@gmail.com>
Date: Fri, 20 Sep 2019 09:49:30 -0400
Subject: [PATCH 05/34] Switch to using fake phantom type

---
 src/Reflex/PerformEvent/Base.hs       | 20 ++++++++--------
 src/Reflex/Requester/Base/Internal.hs | 33 ++++++---------------------
 2 files changed, 17 insertions(+), 36 deletions(-)

diff --git a/src/Reflex/PerformEvent/Base.hs b/src/Reflex/PerformEvent/Base.hs
index e1f9c551..a917fbfb 100644
--- a/src/Reflex/PerformEvent/Base.hs
+++ b/src/Reflex/PerformEvent/Base.hs
@@ -85,18 +85,18 @@ instance (ReflexHost t, Ref m ~ Ref IO, PrimMonad (HostFrame t)) => PerformEvent
 
 instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT t m) where
   runWithReplace a0 a' = PerformEventT $ RequesterT $ do
-    env@(_, _ :: TagGen (PrimState (HostFrame t)) s) <- RequesterInternalT ask
-    let runA :: forall a. PerformEventT t m a -> HostFrame t (a, Event t (Seq (RequestEnvelope s (HostFrame t))))
+    env@(_, _ :: TagGen (PrimState (HostFrame t)) FakeRequesterStatePhantom) <- RequesterInternalT ask
+    let runA :: forall a. PerformEventT t m a -> HostFrame t (a, Event t (Seq (RequestEnvelope FakeRequesterStatePhantom (HostFrame t))))
         runA (PerformEventT (RequesterT a)) = runEventWriterT $ runReaderT (unRequesterInternalT a) env
     (result0, requests0) <- lift $ runA a0
-    newA <- requestingIdentity $ traceEventWith (const "running new widget") $ runA <$> a'
-    requests <- switchHoldPromptOnly requests0 $ traceEventWith (const "updating runWithReplace") $ fmapCheap snd newA
+    newA <- requestingIdentity $ runA <$> a'
+    requests <- switchHoldPromptOnly requests0 $ fmapCheap snd newA
     --TODO: promptly *prevent* events, then sign up the new ones; this is a serious breaking change to PerformEvent
     RequesterInternalT $ tellEvent requests
     pure (result0, fmapCheap fst newA)
   traverseIntMapWithKeyWithAdjust f a0 a' = PerformEventT $ RequesterT $ do
-    env@(_, _ :: TagGen (PrimState (HostFrame t)) s) <- RequesterInternalT ask
-    let runA :: forall a. PerformEventT t m a -> HostFrame t (a, Event t (Seq (RequestEnvelope s (HostFrame t))))
+    env@(_, _ :: TagGen (PrimState (HostFrame t)) FakeRequesterStatePhantom) <- RequesterInternalT ask
+    let runA :: forall a. PerformEventT t m a -> HostFrame t (a, Event t (Seq (RequestEnvelope FakeRequesterStatePhantom (HostFrame t))))
         runA (PerformEventT (RequesterT a)) = runEventWriterT $ runReaderT (unRequesterInternalT a) env
     children' <- requestingIdentity $ itraverse (\k -> runA . f k) <$> a'
     children0 <- lift $ itraverse (\k -> runA . f k) a0
@@ -109,8 +109,8 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT
     RequesterInternalT $ tellEvent $ fforMaybeCheap requests $ \m -> if null m then Nothing else Just $ fold m
     pure (results0, results')
   traverseDMapWithKeyWithAdjust (f :: forall a. k a -> v a -> PerformEventT t m (v' a)) (a0 :: DMap k v) a' = PerformEventT $ RequesterT $ do
-    env@(_, _ :: TagGen (PrimState (HostFrame t)) s) <- RequesterInternalT ask
-    let runA :: forall a. k a -> v a -> HostFrame t (Compose ((,) (Event t (Seq (RequestEnvelope s (HostFrame t))))) v' a)
+    env@(_, _ :: TagGen (PrimState (HostFrame t)) FakeRequesterStatePhantom) <- RequesterInternalT ask
+    let runA :: forall a. k a -> v a -> HostFrame t (Compose ((,) (Event t (Seq (RequestEnvelope FakeRequesterStatePhantom (HostFrame t))))) v' a)
         runA k v = fmap (Compose . swap) $ runEventWriterT $ runReaderT (unRequesterInternalT a) env
           where (PerformEventT (RequesterT a)) = f k v
     children' <- requestingIdentity $ traversePatchDMapWithKey runA <$> a'
@@ -124,8 +124,8 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT
     RequesterInternalT $ tellEvent $ fforMaybeCheap requests $ \m -> if null m then Nothing else Just $ fold m
     pure (results0, results')
   traverseDMapWithKeyWithAdjustWithMove (f :: forall a. k a -> v a -> PerformEventT t m (v' a)) (a0 :: DMap k v) a' = PerformEventT $ RequesterT $ do
-    env@(_, _ :: TagGen (PrimState (HostFrame t)) s) <- RequesterInternalT ask
-    let runA :: forall a. k a -> v a -> HostFrame t (Compose ((,) (Event t (Seq (RequestEnvelope s (HostFrame t))))) v' a)
+    env@(_, _ :: TagGen (PrimState (HostFrame t)) FakeRequesterStatePhantom) <- RequesterInternalT ask
+    let runA :: forall a. k a -> v a -> HostFrame t (Compose ((,) (Event t (Seq (RequestEnvelope FakeRequesterStatePhantom (HostFrame t))))) v' a)
         runA k v = fmap (Compose . swap) $ runEventWriterT $ runReaderT (unRequesterInternalT a) env
           where (PerformEventT (RequesterT a)) = f k v
     children' <- requestingIdentity $ traversePatchDMapWithMoveWithKey runA <$> a'
diff --git a/src/Reflex/Requester/Base/Internal.hs b/src/Reflex/Requester/Base/Internal.hs
index 53a424af..6beeefe6 100644
--- a/src/Reflex/Requester/Base/Internal.hs
+++ b/src/Reflex/Requester/Base/Internal.hs
@@ -63,6 +63,8 @@ import Data.GADT.Compare
 import Data.Witherable
 import Data.Foldable
 
+import Unsafe.Coerce
+
 import Debug.Trace
 
 --TODO: The use of Seq in this module could probably be replaced with something
@@ -90,7 +92,7 @@ runRequesterT :: forall t request response m a
   -> m (a, Event t (RequestData (PrimState m) request))
 runRequesterT (RequesterT a) wrappedResponses = withRequesterInternalT $ \(requests :: Event t (Seq (RequestEnvelope s request))) -> do
   (_, tg) <- RequesterInternalT ask
-  result <- a
+  result <- (unsafeCoerce :: RequesterInternalT FakeRequesterStatePhantom t request response m a -> RequesterInternalT s t request response m a) a
   let responses = fforMaybe wrappedResponses $ \(ResponseData tg' m) -> case tg `geq` tg' of
         Nothing -> trace ("runRequesterT: bad TagGen: expected " <> show tg <> " but got " <> show tg') Nothing --TODO: Warn somehow
         Just Refl -> Just m
@@ -120,32 +122,11 @@ withRequesterInternalT f = withTagGen $ \tg -> do
 
 data RequestEnvelope s request = forall a. RequestEnvelope {-# UNPACK #-} !(Maybe (Tag s a)) !(request a)
 
-newtype RequesterT t (request :: * -> *) (response :: * -> *) m a = RequesterT { unRequesterT :: forall s. RequesterInternalT s t request response m a }
-
-instance Functor m => Functor (RequesterT t request response m) where
-  fmap f (RequesterT x) = RequesterT $ fmap f x
-
-instance Monad m => Applicative (RequesterT t request response m) where
-  pure x = RequesterT $ pure x
-  RequesterT f <*> RequesterT x = RequesterT $ f <*> x
-  liftA2 f (RequesterT a) (RequesterT b) = RequesterT $ liftA2 f a b
-  RequesterT f <* RequesterT x = RequesterT $ f <* x
-  RequesterT f *> RequesterT x = RequesterT $ f *> x
-
-instance Monad m => Monad (RequesterT t request response m) where
-  return = pure
-  RequesterT mx >>= f = RequesterT $ mx >>= \x -> case f x of
-    RequesterT y -> y
-
-instance MonadFix m => MonadFix (RequesterT t request response m) where
-  mfix f = RequesterT $ mfix $ \x -> case f x of
-    RequesterT a -> a
-
-instance MonadIO m => MonadIO (RequesterT t request respnose m) where
-  liftIO a = RequesterT $ liftIO a
+-- This is because using forall ruins inlining
+data FakeRequesterStatePhantom
 
-instance MonadException m => MonadException (RequesterT t request respnose m) where
-  throw e = RequesterT $ throw e
+newtype RequesterT t (request :: * -> *) (response :: * -> *) m a = RequesterT { unRequesterT :: RequesterInternalT FakeRequesterStatePhantom t request response m a }
+  deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException)
 
 newtype RequesterInternalT s t request response m a = RequesterInternalT { unRequesterInternalT :: ReaderT (EventSelectorTag t s response, TagGen (PrimState m) s) (EventWriterT t (Seq (RequestEnvelope s request)) m) a }
   deriving

From d9144d69c4b3416f476b8e2876e1c6c8ffdb7c75 Mon Sep 17 00:00:00 2001
From: Ryan Trinkle <ryan.trinkle@gmail.com>
Date: Fri, 20 Sep 2019 10:54:41 -0400
Subject: [PATCH 06/34] Try using NonEmptyDeferred

---
 src/Data/List/NonEmpty/Deferred.hs    | 26 +++++++++++++++++++++++
 src/Reflex/PerformEvent/Base.hs       | 30 ++++++++++++++++++++-------
 src/Reflex/Requester/Base/Internal.hs | 17 ++++++++-------
 3 files changed, 59 insertions(+), 14 deletions(-)
 create mode 100644 src/Data/List/NonEmpty/Deferred.hs

diff --git a/src/Data/List/NonEmpty/Deferred.hs b/src/Data/List/NonEmpty/Deferred.hs
new file mode 100644
index 00000000..35b95571
--- /dev/null
+++ b/src/Data/List/NonEmpty/Deferred.hs
@@ -0,0 +1,26 @@
+-- | Uses a non-associative internal structure to represent a NonEmpty list, but
+-- prevents external observers from observing the non-associativity.  This
+-- allows O(1) '(<>)'.
+
+{-# LANGUAGE LambdaCase #-}
+module Data.List.NonEmpty.Deferred where
+
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NonEmpty
+
+data NonEmptyDeferred a
+   = NonEmptyDeferred_Singleton a
+   | NonEmptyDeferred_Append !(NonEmptyDeferred a) !(NonEmptyDeferred a)
+
+singleton :: a -> NonEmptyDeferred a
+singleton = NonEmptyDeferred_Singleton
+
+{-# INLINE toNonEmpty #-}
+toNonEmpty :: NonEmptyDeferred a -> NonEmpty a
+toNonEmpty = go []
+  where go t = \case
+          NonEmptyDeferred_Singleton a -> a :| t
+          NonEmptyDeferred_Append a b -> go (NonEmpty.toList $ go t b) a
+
+instance Semigroup (NonEmptyDeferred a) where
+  (<>) = NonEmptyDeferred_Append
diff --git a/src/Reflex/PerformEvent/Base.hs b/src/Reflex/PerformEvent/Base.hs
index e1f9c551..ff8be249 100644
--- a/src/Reflex/PerformEvent/Base.hs
+++ b/src/Reflex/PerformEvent/Base.hs
@@ -47,6 +47,12 @@ import Data.Functor.Compose
 import Data.Functor.Misc
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IntMap
+import Data.List.NonEmpty (NonEmpty (..))
+import Data.List.NonEmpty.Deferred (NonEmptyDeferred)
+import qualified Data.List.NonEmpty.Deferred as NonEmptyDeferred
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Semigroup (Semigroup (sconcat))
 import qualified Data.Semigroup as S
 import Data.Unique.Tag.Local
 import Data.Sequence (Seq)
@@ -86,7 +92,7 @@ instance (ReflexHost t, Ref m ~ Ref IO, PrimMonad (HostFrame t)) => PerformEvent
 instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT t m) where
   runWithReplace a0 a' = PerformEventT $ RequesterT $ do
     env@(_, _ :: TagGen (PrimState (HostFrame t)) s) <- RequesterInternalT ask
-    let runA :: forall a. PerformEventT t m a -> HostFrame t (a, Event t (Seq (RequestEnvelope s (HostFrame t))))
+    let runA :: forall a. PerformEventT t m a -> HostFrame t (a, Event t (NonEmptyDeferred (RequestEnvelope s (HostFrame t))))
         runA (PerformEventT (RequesterT a)) = runEventWriterT $ runReaderT (unRequesterInternalT a) env
     (result0, requests0) <- lift $ runA a0
     newA <- requestingIdentity $ traceEventWith (const "running new widget") $ runA <$> a'
@@ -96,7 +102,7 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT
     pure (result0, fmapCheap fst newA)
   traverseIntMapWithKeyWithAdjust f a0 a' = PerformEventT $ RequesterT $ do
     env@(_, _ :: TagGen (PrimState (HostFrame t)) s) <- RequesterInternalT ask
-    let runA :: forall a. PerformEventT t m a -> HostFrame t (a, Event t (Seq (RequestEnvelope s (HostFrame t))))
+    let runA :: forall a. PerformEventT t m a -> HostFrame t (a, Event t (NonEmptyDeferred (RequestEnvelope s (HostFrame t))))
         runA (PerformEventT (RequesterT a)) = runEventWriterT $ runReaderT (unRequesterInternalT a) env
     children' <- requestingIdentity $ itraverse (\k -> runA . f k) <$> a'
     children0 <- lift $ itraverse (\k -> runA . f k) a0
@@ -106,11 +112,11 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT
         requests' = fmap snd `fmapCheap` children'
     requests <- switchHoldPromptOnlyIncremental mergeIntIncremental coincidencePatchIntMap requests0 $ requests'
     --TODO: promptly *prevent* events, then sign up the new ones; this is a serious breaking change to PerformEvent
-    RequesterInternalT $ tellEvent $ fforMaybeCheap requests $ \m -> if null m then Nothing else Just $ fold m
+    RequesterInternalT $ tellEvent $ fforMaybeCheap requests concatIntMapMaybe
     pure (results0, results')
   traverseDMapWithKeyWithAdjust (f :: forall a. k a -> v a -> PerformEventT t m (v' a)) (a0 :: DMap k v) a' = PerformEventT $ RequesterT $ do
     env@(_, _ :: TagGen (PrimState (HostFrame t)) s) <- RequesterInternalT ask
-    let runA :: forall a. k a -> v a -> HostFrame t (Compose ((,) (Event t (Seq (RequestEnvelope s (HostFrame t))))) v' a)
+    let runA :: forall a. k a -> v a -> HostFrame t (Compose ((,) (Event t (NonEmptyDeferred (RequestEnvelope s (HostFrame t))))) v' a)
         runA k v = fmap (Compose . swap) $ runEventWriterT $ runReaderT (unRequesterInternalT a) env
           where (PerformEventT (RequesterT a)) = f k v
     children' <- requestingIdentity $ traversePatchDMapWithKey runA <$> a'
@@ -121,11 +127,11 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT
         requests' = weakenPatchDMapWith (fst . getCompose) `fmapCheap` children'
     requests <- switchHoldPromptOnlyIncremental mergeMapIncremental coincidencePatchMap requests0 $ requests'
     --TODO: promptly *prevent* events, then sign up the new ones; this is a serious breaking change to PerformEvent
-    RequesterInternalT $ tellEvent $ fforMaybeCheap requests $ \m -> if null m then Nothing else Just $ fold m
+    RequesterInternalT $ tellEvent $ fforMaybeCheap requests concatMapMaybe
     pure (results0, results')
   traverseDMapWithKeyWithAdjustWithMove (f :: forall a. k a -> v a -> PerformEventT t m (v' a)) (a0 :: DMap k v) a' = PerformEventT $ RequesterT $ do
     env@(_, _ :: TagGen (PrimState (HostFrame t)) s) <- RequesterInternalT ask
-    let runA :: forall a. k a -> v a -> HostFrame t (Compose ((,) (Event t (Seq (RequestEnvelope s (HostFrame t))))) v' a)
+    let runA :: forall a. k a -> v a -> HostFrame t (Compose ((,) (Event t (NonEmptyDeferred (RequestEnvelope s (HostFrame t))))) v' a)
         runA k v = fmap (Compose . swap) $ runEventWriterT $ runReaderT (unRequesterInternalT a) env
           where (PerformEventT (RequesterT a)) = f k v
     children' <- requestingIdentity $ traversePatchDMapWithMoveWithKey runA <$> a'
@@ -136,9 +142,19 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT
         requests' = weakenPatchDMapWithMoveWith (fst . getCompose) `fmapCheap` children'
     requests <- switchHoldPromptOnlyIncremental mergeMapIncrementalWithMove coincidencePatchMapWithMove requests0 $ requests'
     --TODO: promptly *prevent* events, then sign up the new ones; this is a serious breaking change to PerformEvent
-    RequesterInternalT $ tellEvent $ fforMaybeCheap requests $ \m -> if null m then Nothing else Just $ fold m
+    RequesterInternalT $ tellEvent $ fforMaybeCheap requests concatMapMaybe
     pure (results0, results')
 
+concatIntMapMaybe :: Semigroup a => IntMap a -> Maybe a
+concatIntMapMaybe m = case IntMap.elems m of
+  [] -> Nothing
+  h : t -> Just $ sconcat $ h :| t
+
+concatMapMaybe :: Semigroup a => Map k a -> Maybe a
+concatMapMaybe m = case Map.elems m of
+  [] -> Nothing
+  h : t -> Just $ sconcat $ h :| t
+
 defaultAdjustBase :: forall t v v2 k' p. (Monad (HostFrame t), PrimMonad (HostFrame t), Reflex t)
   => ((forall a. k' a -> v a -> HostFrame t (v2 a)) -> p k' v -> HostFrame t (p k' v2))
   -> (forall a. k' a -> v a -> HostFrame t (v2 a))
diff --git a/src/Reflex/Requester/Base/Internal.hs b/src/Reflex/Requester/Base/Internal.hs
index 53a424af..a9646beb 100644
--- a/src/Reflex/Requester/Base/Internal.hs
+++ b/src/Reflex/Requester/Base/Internal.hs
@@ -45,6 +45,9 @@ import Data.Functor.Compose
 import Data.Functor.Misc
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IntMap
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.List.NonEmpty.Deferred (NonEmptyDeferred)
+import qualified Data.List.NonEmpty.Deferred as NonEmptyDeferred
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Monoid ((<>))
@@ -71,11 +74,11 @@ import Debug.Trace
 --implemented as a binary tree whose representation isn't associative, but which
 --doesn't allow any external party to observe the lack of associativity.
 
-data RequestData ps request = forall s. RequestData !(TagGen ps s) !(Seq (RequestEnvelope s request))
+data RequestData ps request = forall s. RequestData !(TagGen ps s) !(NonEmptyDeferred (RequestEnvelope s request))
 data ResponseData ps response = forall s. ResponseData !(TagGen ps s) !(TagMap s response)
 
 traverseRequesterData :: forall m request response. Applicative m => (forall a. request a -> m (response a)) -> RequestData (PrimState m) request -> m (ResponseData (PrimState m) response)
-traverseRequesterData f (RequestData tg es) = ResponseData tg . TagMap.fromList <$> wither g (toList es)
+traverseRequesterData f (RequestData tg es) = ResponseData tg . TagMap.fromList <$> wither g (NonEmpty.toList $ NonEmptyDeferred.toNonEmpty es)
   where g (RequestEnvelope mt req) = case mt of
           Just t -> Just . (t :=>) <$> f req
           Nothing -> Nothing <$ f req
@@ -88,7 +91,7 @@ runRequesterT :: forall t request response m a
   => RequesterT t request response m a
   -> Event t (ResponseData (PrimState m) response)
   -> m (a, Event t (RequestData (PrimState m) request))
-runRequesterT (RequesterT a) wrappedResponses = withRequesterInternalT $ \(requests :: Event t (Seq (RequestEnvelope s request))) -> do
+runRequesterT (RequesterT a) wrappedResponses = withRequesterInternalT $ \(requests :: Event t (NonEmptyDeferred (RequestEnvelope s request))) -> do
   (_, tg) <- RequesterInternalT ask
   result <- a
   let responses = fforMaybe wrappedResponses $ \(ResponseData tg' m) -> case tg `geq` tg' of
@@ -111,7 +114,7 @@ withRequesterInternalT
      , PrimMonad m
      , MonadFix m
      )
-  => (forall s. Event t (Seq (RequestEnvelope s request)) -> RequesterInternalT s t request response m (Event t (TagMap s response), a))
+  => (forall s. Event t (NonEmptyDeferred (RequestEnvelope s request)) -> RequesterInternalT s t request response m (Event t (TagMap s response), a))
   -> m a
 withRequesterInternalT f = withTagGen $ \tg -> do
   rec let RequesterInternalT a = f requests
@@ -147,7 +150,7 @@ instance MonadIO m => MonadIO (RequesterT t request respnose m) where
 instance MonadException m => MonadException (RequesterT t request respnose m) where
   throw e = RequesterT $ throw e
 
-newtype RequesterInternalT s t request response m a = RequesterInternalT { unRequesterInternalT :: ReaderT (EventSelectorTag t s response, TagGen (PrimState m) s) (EventWriterT t (Seq (RequestEnvelope s request)) m) a }
+newtype RequesterInternalT s t request response m a = RequesterInternalT { unRequesterInternalT :: ReaderT (EventSelectorTag t s response, TagGen (PrimState m) s) (EventWriterT t (NonEmptyDeferred (RequestEnvelope s request)) m) a }
   deriving
     ( Functor, Applicative, Monad, MonadFix, MonadIO, MonadException
 #if MIN_VERSION_base(4,9,1)
@@ -215,10 +218,10 @@ instance (Reflex t, PrimMonad m) => Requester t (RequesterInternalT s t request
   requesting e = RequesterInternalT $ do
     (s, tg) <- ask
     t <- lift $ lift $ newTag tg
-    tellEvent $ fmapCheap (Seq.singleton . RequestEnvelope (Just t)) e
+    tellEvent $ fmapCheap (NonEmptyDeferred.singleton . RequestEnvelope (Just t)) e
     pure $ selectTag s t
   requesting_ e = RequesterInternalT $ do
-    tellEvent $ fmapCheap (Seq.singleton . RequestEnvelope Nothing) e
+    tellEvent $ fmapCheap (NonEmptyDeferred.singleton . RequestEnvelope Nothing) e
 
 instance (Adjustable t m, MonadHold t m) => Adjustable t (RequesterInternalT s t request response m) where
   {-# INLINABLE runWithReplace #-}

From 99213f6cb18120dc9e79854b1d2e88c132471da9 Mon Sep 17 00:00:00 2001
From: Ryan Trinkle <ryan.trinkle@gmail.com>
Date: Fri, 20 Sep 2019 11:39:24 -0400
Subject: [PATCH 07/34] Restrict Data.List.NonEmpty.Deferred's interface

---
 src/Data/List/NonEmpty/Deferred.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/src/Data/List/NonEmpty/Deferred.hs b/src/Data/List/NonEmpty/Deferred.hs
index 35b95571..035f1119 100644
--- a/src/Data/List/NonEmpty/Deferred.hs
+++ b/src/Data/List/NonEmpty/Deferred.hs
@@ -3,7 +3,11 @@
 -- allows O(1) '(<>)'.
 
 {-# LANGUAGE LambdaCase #-}
-module Data.List.NonEmpty.Deferred where
+module Data.List.NonEmpty.Deferred
+  ( NonEmptyDeferred
+  , singleton
+  , toNonEmpty
+  ) where
 
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NonEmpty

From de53a951b999109d515d0ed9fdc8f91f74b7319b Mon Sep 17 00:00:00 2001
From: Ryan Trinkle <ryan.trinkle@gmail.com>
Date: Fri, 20 Sep 2019 11:39:47 -0400
Subject: [PATCH 08/34] Add Data.List.NonEmpty.Deferred to cabal file

---
 reflex.cabal | 1 +
 1 file changed, 1 insertion(+)

diff --git a/reflex.cabal b/reflex.cabal
index 8779a9a9..d8368490 100644
--- a/reflex.cabal
+++ b/reflex.cabal
@@ -91,6 +91,7 @@ library
     Data.FastMutableIntMap,
     Data.FastWeakBag,
     Data.Functor.Misc,
+    Data.List.NonEmpty.Deferred,
     Data.Map.Misc,
     Data.TagMap,
     Data.Unique.Tag.Local,

From ead9cd587eadb43e8beb5a20ca9ec1677a87902d Mon Sep 17 00:00:00 2001
From: Ryan Trinkle <ryan.trinkle@gmail.com>
Date: Fri, 20 Sep 2019 11:40:35 -0400
Subject: [PATCH 09/34] Use NonEmptyDeferred and direct sconcat (which uses
 mergeInt under the hood) for EventWriterT

---
 src/Reflex/EventWriter/Base.hs | 57 ++++------------------------------
 1 file changed, 6 insertions(+), 51 deletions(-)

diff --git a/src/Reflex/EventWriter/Base.hs b/src/Reflex/EventWriter/Base.hs
index 83a4397f..ce78084f 100644
--- a/src/Reflex/EventWriter/Base.hs
+++ b/src/Reflex/EventWriter/Base.hs
@@ -47,6 +47,8 @@ import Data.GADT.Compare (GCompare (..), GEq (..), GOrdering (..))
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IntMap
 import Data.List.NonEmpty (NonEmpty (..))
+import Data.List.NonEmpty.Deferred (NonEmptyDeferred)
+import qualified Data.List.NonEmpty.Deferred as NonEmptyDeferred
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Semigroup
@@ -54,45 +56,7 @@ import Data.Some (Some)
 import Data.Tuple
 import Data.Type.Equality
 
-import Unsafe.Coerce
-
-{-# DEPRECATED TellId "Do not construct this directly; use tellId instead" #-}
-newtype TellId w x
-  = TellId Int -- ^ WARNING: Do not construct this directly; use 'tellId' instead
-  deriving (Show, Eq, Ord, Enum)
-
-tellId :: Int -> TellId w w
-tellId = TellId
-{-# INLINE tellId #-}
-
-tellIdRefl :: TellId w x -> w :~: x
-tellIdRefl _ = unsafeCoerce Refl
-
-withTellIdRefl :: TellId w x -> (w ~ x => r) -> r
-withTellIdRefl tid r = case tellIdRefl tid of
-  Refl -> r
-
-instance GEq (TellId w) where
-  a `geq` b =
-    withTellIdRefl a $
-    withTellIdRefl b $
-    if a == b
-    then Just Refl
-    else Nothing
-
-instance GCompare (TellId w) where
-  a `gcompare` b =
-    withTellIdRefl a $
-    withTellIdRefl b $
-    case a `compare` b of
-      LT -> GLT
-      EQ -> GEQ
-      GT -> GGT
-
-data EventWriterState t w = EventWriterState
-  { _eventWriterState_nextId :: {-# UNPACK #-} !Int -- Always negative (and decreasing over time)
-  , _eventWriterState_told :: ![DSum (TellId w) (Event t)] -- In increasing order
-  }
+type EventWriterState t w = Maybe (NonEmptyDeferred (Event t w))
 
 -- | A basic implementation of 'EventWriter'.
 newtype EventWriterT t w m a = EventWriterT { unEventWriterT :: StateT (EventWriterState t w) m a }
@@ -101,20 +65,11 @@ newtype EventWriterT t w m a = EventWriterT { unEventWriterT :: StateT (EventWri
 -- | Run a 'EventWriterT' action.
 runEventWriterT :: forall t m w a. (Reflex t, Monad m, Semigroup w) => EventWriterT t w m a -> m (a, Event t w)
 runEventWriterT (EventWriterT a) = do
-  (result, requests) <- runStateT a $ EventWriterState (-1) []
-  let combineResults :: DMap (TellId w) Identity -> w
-      combineResults = sconcat
-        . (\(h : t) -> h :| t) -- Unconditional; 'merge' guarantees that it will only fire with non-empty DMaps
-        . DMap.foldlWithKey (\vs tid (Identity v) -> withTellIdRefl tid $ v : vs) [] -- This is where we finally reverse the DMap to get things in the correct order
-  return (result, fmap combineResults $ merge $ DMap.fromDistinctAscList $ _eventWriterState_told requests) --TODO: We can probably make this fromDistinctAscList more efficient by knowing the length in advance, but this will require exposing internals of DMap; also converting it to use a strict list might help
+  (result, requests) <- runStateT a Nothing
+  return (result, maybe never (sconcat . NonEmptyDeferred.toNonEmpty) requests)
 
 instance (Reflex t, Monad m, Semigroup w) => EventWriter t w (EventWriterT t w m) where
-  tellEvent w = EventWriterT $ modify $ \old ->
-    let myId = _eventWriterState_nextId old
-    in EventWriterState
-       { _eventWriterState_nextId = pred myId
-       , _eventWriterState_told = (tellId myId :=> w) : _eventWriterState_told old
-       }
+  tellEvent w = EventWriterT $ modify (<> Just (NonEmptyDeferred.singleton w))
 
 instance MonadTrans (EventWriterT t w) where
   lift = EventWriterT . lift

From e39c56c45e77613f7352b27e9057fb9e5fcffd57 Mon Sep 17 00:00:00 2001
From: Ryan Trinkle <ryan.trinkle@gmail.com>
Date: Fri, 20 Sep 2019 13:38:11 -0400
Subject: [PATCH 10/34] Various simplifications

---
 src/Reflex/Class.hs            | 15 ++++++++++++++-
 src/Reflex/EventWriter/Base.hs |  2 +-
 2 files changed, 15 insertions(+), 2 deletions(-)

diff --git a/src/Reflex/Class.hs b/src/Reflex/Class.hs
index dd5a3d8c..190d17dd 100644
--- a/src/Reflex/Class.hs
+++ b/src/Reflex/Class.hs
@@ -169,6 +169,7 @@ module Reflex.Class
   , tagCheap
   , mergeWithCheap
   , mergeWithCheap'
+  , sconcatCheap
     -- * Slow, but general, implementations
   , slowHeadE
   ) where
@@ -890,6 +891,9 @@ instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
   sconcat = fmap sconcat . mergeList . toList
   stimes n = fmap $ stimes n
 
+sconcatCheap :: (Semigroup a, Reflex t) => NonEmpty (Event t a) -> Event t a
+sconcatCheap = fmapCheap sconcat . mergeList . toList
+
 instance (Semigroup a, Reflex t) => Monoid (Event t a) where
   mempty = never
   mappend = (<>)
@@ -904,6 +908,8 @@ mergeWith = mergeWith' id
 
 {-# INLINE mergeWith' #-}
 mergeWith' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b
+mergeWith' _ _ [] = never
+mergeWith' f _ [e] = fmap f e
 mergeWith' f g es = fmap (Prelude.foldl1 g . fmap f)
                   . mergeInt
                   . IntMap.fromDistinctAscList
@@ -921,6 +927,7 @@ leftmost = mergeWith const
 -- time.
 mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
 mergeList [] = never
+mergeList [e] = fmapCheap (:|[]) e
 mergeList es = mergeWithFoldCheap' id es
 
 unsafeMapIncremental
@@ -1017,7 +1024,11 @@ switchHoldPromptly ea0 eea = do
 switchHoldPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
 switchHoldPromptOnly e0 e' = do
   eLag <- switch <$> hold e0 e'
-  return $ coincidence $ leftmost [e', eLag <$ eLag]
+  return $ fmapMaybeCheap id $ leftmost
+    [ fmapCheap Just $ coincidence e'
+    , fmapCheap (const Nothing) e'
+    , fmapCheap Just eLag
+    ]
 
 -- | When the given outer event fires, condense the inner events into the contained patch.  Non-firing inner events will be replaced with deletions.
 coincidencePatchMap :: (Reflex t, Ord k) => Event t (PatchMap k (Event t v)) -> Event t (PatchMap k v)
@@ -1649,6 +1660,8 @@ mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
 -- | A "cheap" version of 'mergeWithFoldCheap''. See the performance note on 'pushCheap'.
 {-# INLINE mergeWithFoldCheap' #-}
 mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
+mergeWithFoldCheap' f [] = never
+mergeWithFoldCheap' f [e] = fmapCheap (f . (:|[])) e
 mergeWithFoldCheap' f es =
   fmapCheap (f . (\(h : t) -> h :| t) . IntMap.elems)
   . mergeInt
diff --git a/src/Reflex/EventWriter/Base.hs b/src/Reflex/EventWriter/Base.hs
index ce78084f..0243730d 100644
--- a/src/Reflex/EventWriter/Base.hs
+++ b/src/Reflex/EventWriter/Base.hs
@@ -66,7 +66,7 @@ newtype EventWriterT t w m a = EventWriterT { unEventWriterT :: StateT (EventWri
 runEventWriterT :: forall t m w a. (Reflex t, Monad m, Semigroup w) => EventWriterT t w m a -> m (a, Event t w)
 runEventWriterT (EventWriterT a) = do
   (result, requests) <- runStateT a Nothing
-  return (result, maybe never (sconcat . NonEmptyDeferred.toNonEmpty) requests)
+  return (result, maybe never (sconcatCheap . NonEmptyDeferred.toNonEmpty) requests)
 
 instance (Reflex t, Monad m, Semigroup w) => EventWriter t w (EventWriterT t w m) where
   tellEvent w = EventWriterT $ modify (<> Just (NonEmptyDeferred.singleton w))

From 677ce27c827c1a4f8370c79e24d01e4e32ca52f8 Mon Sep 17 00:00:00 2001
From: Ryan Trinkle <ryan.trinkle@gmail.com>
Date: Fri, 20 Sep 2019 19:49:46 -0400
Subject: [PATCH 11/34] Some more random cleanups

---
 reflex.cabal                          |  5 +++++
 src/Reflex/Class.hs                   | 29 +++++++++++++++------------
 src/Reflex/PerformEvent/Base.hs       |  6 +++---
 src/Reflex/Requester/Base/Internal.hs |  6 ------
 4 files changed, 24 insertions(+), 22 deletions(-)

diff --git a/reflex.cabal b/reflex.cabal
index d8368490..d7294017 100644
--- a/reflex.cabal
+++ b/reflex.cabal
@@ -144,6 +144,7 @@ library
     Reflex.Workflow
 
   ghc-options: -Wall -fwarn-redundant-constraints -fwarn-tabs -funbox-strict-fields -O2 -fspecialise-aggressively
+  ghc-prof-options: -fprof-auto-calls
 
   if flag(debug-trace-events)
     cpp-options: -DDEBUG_TRACE_EVENTS
@@ -179,6 +180,7 @@ test-suite semantics
   main-is: semantics.hs
   hs-source-dirs: test
   ghc-options: -O2 -Wall -rtsopts
+  ghc-prof-options: -fprof-auto-calls
   build-depends:
     base,
     bifunctors,
@@ -204,6 +206,7 @@ test-suite CrossImpl
   main-is: Reflex/Test/CrossImpl.hs
   hs-source-dirs: test
   ghc-options: -O2 -Wall -rtsopts
+  ghc-prof-options: -fprof-auto-calls
   build-depends:
     base,
     containers,
@@ -356,6 +359,7 @@ benchmark spider-bench
   hs-source-dirs: bench test
   main-is: Main.hs
   ghc-options: -Wall -O2 -rtsopts
+  ghc-prof-options: -fprof-auto-calls
   build-depends:
     base,
     containers,
@@ -381,6 +385,7 @@ benchmark saulzar-bench
   c-sources: bench-cbits/checkCapability.c
   main-is: RunAll.hs
   ghc-options: -Wall -O2 -rtsopts -threaded
+  ghc-prof-options: -fprof-auto-calls
   build-depends:
     base,
     containers,
diff --git a/src/Reflex/Class.hs b/src/Reflex/Class.hs
index 190d17dd..86d5ae06 100644
--- a/src/Reflex/Class.hs
+++ b/src/Reflex/Class.hs
@@ -944,10 +944,6 @@ unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIn
 mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
 mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
 
--- | Like 'mergeMap' but for 'IntMap'.
-mergeIntMap :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
-mergeIntMap = fmap dmapToIntMap . merge . intMapWithFunctorToDMap
-
 -- | Create a merge whose parents can change over time
 mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
 mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
@@ -1032,19 +1028,19 @@ switchHoldPromptOnly e0 e' = do
 
 -- | When the given outer event fires, condense the inner events into the contained patch.  Non-firing inner events will be replaced with deletions.
 coincidencePatchMap :: (Reflex t, Ord k) => Event t (PatchMap k (Event t v)) -> Event t (PatchMap k v)
-coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ ffor e $ \(PatchMap m) -> mergeMap $ ffor m $ \case
+coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ fforCheap e $ \(PatchMap m) -> mergeMap $ ffor m $ \case
   Nothing -> fmapCheap (const Nothing) e
   Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
 
 -- | See 'coincidencePatchMap'
 coincidencePatchIntMap :: Reflex t => Event t (PatchIntMap (Event t v)) -> Event t (PatchIntMap v)
-coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ ffor e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case
+coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ fforCheap e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case
   Nothing -> fmapCheap (const Nothing) e
   Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
 
 -- | See 'coincidencePatchMap'
 coincidencePatchMapWithMove :: (Reflex t, Ord k) => Event t (PatchMapWithMove k (Event t v)) -> Event t (PatchMapWithMove k v)
-coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ ffor e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
+coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ fforCheap e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
   PatchMapWithMove.From_Delete -> fforCheap e $ \_ ->
     ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
   PatchMapWithMove.From_Move k -> fforCheap e $ \_ ->
@@ -1304,7 +1300,7 @@ accumMaybeMDyn
   -> Event t b
   -> m (Dynamic t a)
 accumMaybeMDyn f z e = do
-  rec let e' = flip push e $ \o -> do
+  rec let e' = flip pushCheap e $ \o -> do
             v <- sample $ current d'
             f v o
       d' <- holdDyn z e'
@@ -1360,8 +1356,8 @@ mapAccumMaybeMDyn f z e = do
             return $ case result of
               (Nothing, Nothing) -> Nothing
               _ -> Just result
-      d' <- holdDyn z $ mapMaybe fst e'
-  return (d', mapMaybe snd e')
+      d' <- holdDyn z $ fmapMaybeCheap fst e'
+  return (d', fmapMaybeCheap snd e')
 
 -- | Accumulate a 'Behavior' by folding occurrences of an 'Event'
 -- with the provided function.
@@ -1399,7 +1395,7 @@ accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o
 {-# INLINE accumMaybeMB #-}
 accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)
 accumMaybeMB f z e = do
-  rec let e' = flip push e $ \o -> do
+  rec let e' = flip pushCheap e $ \o -> do
             v <- sample d'
             f v o
       d' <- hold z e'
@@ -1449,8 +1445,8 @@ mapAccumMaybeMB f z e = do
             return $ case result of
               (Nothing, Nothing) -> Nothing
               _ -> Just result
-      d' <- hold z $ mapMaybe fst e'
-  return (d', mapMaybe snd e')
+      d' <- hold z $ fmapMaybeCheap fst e'
+  return (d', fmapMaybeCheap snd e')
 
 -- | Accumulate occurrences of an 'Event', producing an output occurrence each
 -- time.  Discard the underlying 'Accumulator'.
@@ -1676,7 +1672,14 @@ mergeWithFoldCheap' f es =
 -- | See 'switchHoldPromptly'
 switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
 switchPromptly = switchHoldPromptly
+
 {-# DEPRECATED switchPromptOnly "Use 'switchHoldPromptOnly' instead. The 'switchHold*' naming convention was chosen because those functions are more closely related to each other than they are to 'switch'. " #-}
 -- | See 'switchHoldPromptOnly'
 switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
 switchPromptOnly = switchHoldPromptOnly
+
+{-# DEPRECATED mergeIntMap "Use 'mergeInt' instead" #-}
+-- | Like 'mergeMap' but for 'IntMap'.
+mergeIntMap :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
+mergeIntMap = mergeInt
+
diff --git a/src/Reflex/PerformEvent/Base.hs b/src/Reflex/PerformEvent/Base.hs
index ff8be249..6a817c71 100644
--- a/src/Reflex/PerformEvent/Base.hs
+++ b/src/Reflex/PerformEvent/Base.hs
@@ -110,7 +110,7 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT
         requests0 = fmap snd children0
         results' = fmap fst <$> children'
         requests' = fmap snd `fmapCheap` children'
-    requests <- switchHoldPromptOnlyIncremental mergeIntIncremental coincidencePatchIntMap requests0 $ requests'
+    requests <- switchHoldPromptOnlyIncremental mergeIntIncremental coincidencePatchIntMap requests0 requests'
     --TODO: promptly *prevent* events, then sign up the new ones; this is a serious breaking change to PerformEvent
     RequesterInternalT $ tellEvent $ fforMaybeCheap requests concatIntMapMaybe
     pure (results0, results')
@@ -125,7 +125,7 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT
         requests0 = weakenDMapWith (fst . getCompose) children0
         results' = mapPatchDMap (snd . getCompose) <$> children'
         requests' = weakenPatchDMapWith (fst . getCompose) `fmapCheap` children'
-    requests <- switchHoldPromptOnlyIncremental mergeMapIncremental coincidencePatchMap requests0 $ requests'
+    requests <- switchHoldPromptOnlyIncremental mergeMapIncremental coincidencePatchMap requests0 requests'
     --TODO: promptly *prevent* events, then sign up the new ones; this is a serious breaking change to PerformEvent
     RequesterInternalT $ tellEvent $ fforMaybeCheap requests concatMapMaybe
     pure (results0, results')
@@ -140,7 +140,7 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT
         requests0 = weakenDMapWith (fst . getCompose) children0
         results' = mapPatchDMapWithMove (snd . getCompose) <$> children'
         requests' = weakenPatchDMapWithMoveWith (fst . getCompose) `fmapCheap` children'
-    requests <- switchHoldPromptOnlyIncremental mergeMapIncrementalWithMove coincidencePatchMapWithMove requests0 $ requests'
+    requests <- switchHoldPromptOnlyIncremental mergeMapIncrementalWithMove coincidencePatchMapWithMove requests0 requests'
     --TODO: promptly *prevent* events, then sign up the new ones; this is a serious breaking change to PerformEvent
     RequesterInternalT $ tellEvent $ fforMaybeCheap requests concatMapMaybe
     pure (results0, results')
diff --git a/src/Reflex/Requester/Base/Internal.hs b/src/Reflex/Requester/Base/Internal.hs
index a9646beb..f3420d50 100644
--- a/src/Reflex/Requester/Base/Internal.hs
+++ b/src/Reflex/Requester/Base/Internal.hs
@@ -68,12 +68,6 @@ import Data.Foldable
 
 import Debug.Trace
 
---TODO: The use of Seq in this module could probably be replaced with something
---even cheaper.  We do need O(1) append, but we don't need associativity until
---the very end, when we're smashing everything together.  This could be
---implemented as a binary tree whose representation isn't associative, but which
---doesn't allow any external party to observe the lack of associativity.
-
 data RequestData ps request = forall s. RequestData !(TagGen ps s) !(NonEmptyDeferred (RequestEnvelope s request))
 data ResponseData ps response = forall s. ResponseData !(TagGen ps s) !(TagMap s response)
 

From d3a3059d31b3493b2c24737d69319a1f0fe1f4dd Mon Sep 17 00:00:00 2001
From: Ryan Trinkle <ryan@trinkle.org>
Date: Fri, 27 Sep 2019 09:02:02 -0400
Subject: [PATCH 12/34] A bit of messing around that seems to help performance

---
 src/Reflex/PerformEvent/Base.hs       |  4 +++
 src/Reflex/Requester/Base/Internal.hs | 43 +++++++++++----------------
 2 files changed, 22 insertions(+), 25 deletions(-)

diff --git a/src/Reflex/PerformEvent/Base.hs b/src/Reflex/PerformEvent/Base.hs
index bfccb139..33b08c91 100644
--- a/src/Reflex/PerformEvent/Base.hs
+++ b/src/Reflex/PerformEvent/Base.hs
@@ -90,6 +90,7 @@ instance (ReflexHost t, Ref m ~ Ref IO, PrimMonad (HostFrame t)) => PerformEvent
   performEvent = PerformEventT . requestingIdentity
 
 instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT t m) where
+  {-# INLINE runWithReplace #-}
   runWithReplace a0 a' = PerformEventT $ RequesterT $ do
     env@(_, _ :: TagGen (PrimState (HostFrame t)) FakeRequesterStatePhantom) <- RequesterInternalT ask
     let runA :: forall a. PerformEventT t m a -> HostFrame t (a, Event t (NonEmptyDeferred (RequestEnvelope FakeRequesterStatePhantom (HostFrame t))))
@@ -100,6 +101,7 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT
     --TODO: promptly *prevent* events, then sign up the new ones; this is a serious breaking change to PerformEvent
     RequesterInternalT $ tellEvent requests
     pure (result0, fmapCheap fst newA)
+  {-# INLINE traverseIntMapWithKeyWithAdjust #-}
   traverseIntMapWithKeyWithAdjust f a0 a' = PerformEventT $ RequesterT $ do
     env@(_, _ :: TagGen (PrimState (HostFrame t)) FakeRequesterStatePhantom) <- RequesterInternalT ask
     let runA :: forall a. PerformEventT t m a -> HostFrame t (a, Event t (NonEmptyDeferred (RequestEnvelope FakeRequesterStatePhantom (HostFrame t))))
@@ -114,6 +116,7 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT
     --TODO: promptly *prevent* events, then sign up the new ones; this is a serious breaking change to PerformEvent
     RequesterInternalT $ tellEvent $ fforMaybeCheap requests concatIntMapMaybe
     pure (results0, results')
+  {-# INLINE traverseDMapWithKeyWithAdjust #-}
   traverseDMapWithKeyWithAdjust (f :: forall a. k a -> v a -> PerformEventT t m (v' a)) (a0 :: DMap k v) a' = PerformEventT $ RequesterT $ do
     env@(_, _ :: TagGen (PrimState (HostFrame t)) FakeRequesterStatePhantom) <- RequesterInternalT ask
     let runA :: forall a. k a -> v a -> HostFrame t (Compose ((,) (Event t (NonEmptyDeferred (RequestEnvelope FakeRequesterStatePhantom (HostFrame t))))) v' a)
@@ -129,6 +132,7 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT
     --TODO: promptly *prevent* events, then sign up the new ones; this is a serious breaking change to PerformEvent
     RequesterInternalT $ tellEvent $ fforMaybeCheap requests concatMapMaybe
     pure (results0, results')
+  {-# INLINE traverseDMapWithKeyWithAdjustWithMove #-}
   traverseDMapWithKeyWithAdjustWithMove (f :: forall a. k a -> v a -> PerformEventT t m (v' a)) (a0 :: DMap k v) a' = PerformEventT $ RequesterT $ do
     env@(_, _ :: TagGen (PrimState (HostFrame t)) FakeRequesterStatePhantom) <- RequesterInternalT ask
     let runA :: forall a. k a -> v a -> HostFrame t (Compose ((,) (Event t (NonEmptyDeferred (RequestEnvelope FakeRequesterStatePhantom (HostFrame t))))) v' a)
diff --git a/src/Reflex/Requester/Base/Internal.hs b/src/Reflex/Requester/Base/Internal.hs
index 0b111351..fc4d6699 100644
--- a/src/Reflex/Requester/Base/Internal.hs
+++ b/src/Reflex/Requester/Base/Internal.hs
@@ -87,9 +87,9 @@ runRequesterT :: forall t request response m a
   => RequesterT t request response m a
   -> Event t (ResponseData (PrimState m) response)
   -> m (a, Event t (RequestData (PrimState m) request))
-runRequesterT (RequesterT a) wrappedResponses = withRequesterInternalT $ \(requests :: Event t (NonEmptyDeferred (RequestEnvelope s request))) -> do
+runRequesterT (RequesterT a) wrappedResponses = withRequesterInternalT $ \requests -> do
   (_, tg) <- RequesterInternalT ask
-  result <- (unsafeCoerce :: RequesterInternalT FakeRequesterStatePhantom t request response m a -> RequesterInternalT s t request response m a) a
+  result <- a
   let responses = fforMaybe wrappedResponses $ \(ResponseData tg' m) -> case tg `geq` tg' of
         Nothing -> trace ("runRequesterT: bad TagGen: expected " <> show tg <> " but got " <> show tg') Nothing --TODO: Warn somehow
         Just Refl -> Just m
@@ -106,14 +106,18 @@ instance MonadTrans (RequesterT t request response) where
 -- The 'Tag' keys will be used to return the responses to the same place the
 -- requests were issued.
 withRequesterInternalT
-  :: ( Reflex t
+  :: forall t m request response a.
+     ( Reflex t
      , PrimMonad m
      , MonadFix m
      )
-  => (forall s. Event t (NonEmptyDeferred (RequestEnvelope s request)) -> RequesterInternalT s t request response m (Event t (TagMap s response), a))
+  => (Event t (NonEmptyDeferred (RequestEnvelope FakeRequesterStatePhantom request)) -> RequesterInternalT FakeRequesterStatePhantom  t request response m (Event t (TagMap FakeRequesterStatePhantom response), a))
   -> m a
-withRequesterInternalT f = withTagGen $ \tg -> do
-  rec let RequesterInternalT a = f requests
+withRequesterInternalT f = do
+  stg <- newTagGen
+  let tg = case stg of
+        Some tg' -> (unsafeCoerce :: TagGen (PrimState m) s -> TagGen (PrimState m) FakeRequesterStatePhantom) tg'
+  rec let RequesterInternalT a = (unsafeCoerce :: RequesterInternalT s t request response m (Event t (TagMap FakeRequesterStatePhantom response), a) -> RequesterInternalT FakeRequesterStatePhantom t request response m (Event t (TagMap FakeRequesterStatePhantom response), a)) $ f requests
       ((responses, result), requests) <- runEventWriterT $ runReaderT a (fanTag responses, tg)
   pure result
 
@@ -199,36 +203,25 @@ instance (Reflex t, PrimMonad m) => Requester t (RequesterInternalT s t request
     tellEvent $ fmapCheap (NonEmptyDeferred.singleton . RequestEnvelope Nothing) e
 
 instance (Adjustable t m, MonadHold t m) => Adjustable t (RequesterInternalT s t request response m) where
-  {-# INLINABLE runWithReplace #-}
+  {-# INLINE runWithReplace #-}
   runWithReplace (RequesterInternalT a0) a' = RequesterInternalT $ runWithReplace a0 (coerceEvent a')
-  {-# INLINABLE traverseIntMapWithKeyWithAdjust #-}
+  {-# INLINE traverseIntMapWithKeyWithAdjust #-}
   traverseIntMapWithKeyWithAdjust f dm0 dm' = RequesterInternalT $ traverseIntMapWithKeyWithAdjust (coerce . f) dm0 dm'
-  {-# INLINABLE traverseDMapWithKeyWithAdjust #-}
+  {-# INLINE traverseDMapWithKeyWithAdjust #-}
   traverseDMapWithKeyWithAdjust f dm0 dm' = RequesterInternalT $ traverseDMapWithKeyWithAdjust (coerce . f) dm0 dm'
-  {-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}
+  {-# INLINE traverseDMapWithKeyWithAdjustWithMove #-}
   traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = RequesterInternalT $ traverseDMapWithKeyWithAdjustWithMove (coerce . f) dm0 dm'
 
 instance (Adjustable t m, MonadHold t m) => Adjustable t (RequesterT t request response m) where
-  {-# INLINABLE runWithReplace #-}
+  {-# INLINE runWithReplace #-}
   runWithReplace (RequesterT a0) a' = RequesterT $ runWithReplace a0 (fmapCheap unRequesterT a')
-  {-# INLINABLE traverseIntMapWithKeyWithAdjust #-}
+  {-# INLINE traverseIntMapWithKeyWithAdjust #-}
   traverseIntMapWithKeyWithAdjust f dm0 dm' = RequesterT $ traverseIntMapWithKeyWithAdjust (\k v -> unRequesterT $ f k v) dm0 dm'
-  {-# INLINABLE traverseDMapWithKeyWithAdjust #-}
+  {-# INLINE traverseDMapWithKeyWithAdjust #-}
   traverseDMapWithKeyWithAdjust f dm0 dm' = RequesterT $ traverseDMapWithKeyWithAdjust (\k v -> unRequesterT $ f k v) dm0 dm'
-  {-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}
+  {-# INLINE traverseDMapWithKeyWithAdjustWithMove #-}
   traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = RequesterT $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unRequesterT $ f k v) dm0 dm'
 
-{-# INLINABLE runWithReplaceRequesterTWith #-}
-runWithReplaceRequesterTWith :: forall m t request response a b. (Reflex t, MonadHold t m
-                                                                 , MonadFix m
-                                                                 )
-                             => (forall a' b'. m a' -> Event t (m b') -> RequesterT t request response m (a', Event t b'))
-                             -> RequesterT t request response m a
-                             -> Event t (RequesterT t request response m b)
-                             -> RequesterT t request response m (a, Event t b)
-runWithReplaceRequesterTWith f (RequesterT a0) a' = RequesterT $ do
-  pure undefined
-
 {-
 import GHC.Exts (Any)
 import Unsafe.Coerce

From bf9e0b6489ea1f9af88bc44bd4ea3104e24ed426 Mon Sep 17 00:00:00 2001
From: Ryan Trinkle <ryan@trinkle.org>
Date: Sun, 29 Sep 2019 11:54:58 -0400
Subject: [PATCH 13/34] Improve perf of coincidencePatch*

---
 src/Reflex/Class.hs | 42 +++++++++++++++++++++++++-----------------
 1 file changed, 25 insertions(+), 17 deletions(-)

diff --git a/src/Reflex/Class.hs b/src/Reflex/Class.hs
index 86d5ae06..ca62e5d5 100644
--- a/src/Reflex/Class.hs
+++ b/src/Reflex/Class.hs
@@ -1028,29 +1028,37 @@ switchHoldPromptOnly e0 e' = do
 
 -- | When the given outer event fires, condense the inner events into the contained patch.  Non-firing inner events will be replaced with deletions.
 coincidencePatchMap :: (Reflex t, Ord k) => Event t (PatchMap k (Event t v)) -> Event t (PatchMap k v)
-coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ fforCheap e $ \(PatchMap m) -> mergeMap $ ffor m $ \case
-  Nothing -> fmapCheap (const Nothing) e
-  Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
+coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ fforCheap e $ \(PatchMap m) -> if Map.null m then never else
+  let firingNewItems = mergeMap $ fforMaybe m $ \case
+        Nothing -> Nothing
+        Just ev -> Just $ fmapCheap Just ev
+      oldItemMask = (Nothing <$ m) <$ e
+  in alignWith (mergeThese Map.union) firingNewItems oldItemMask -- Must be left-biased
 
 -- | See 'coincidencePatchMap'
 coincidencePatchIntMap :: Reflex t => Event t (PatchIntMap (Event t v)) -> Event t (PatchIntMap v)
-coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ fforCheap e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case
-  Nothing -> fmapCheap (const Nothing) e
-  Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
+coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ fforCheap e $ \(PatchIntMap m) -> if IntMap.null m then never else
+  let firingNewItems = mergeIntMap $ fforMaybe m $ \case
+        Nothing -> Nothing
+        Just ev -> Just $ fmapCheap Just ev
+      oldItemMask = (Nothing <$ m) <$ e
+  in alignWith (mergeThese IntMap.union) firingNewItems oldItemMask -- Must be left-biased
 
 -- | See 'coincidencePatchMap'
 coincidencePatchMapWithMove :: (Reflex t, Ord k) => Event t (PatchMapWithMove k (Event t v)) -> Event t (PatchMapWithMove k v)
-coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ fforCheap e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
-  PatchMapWithMove.From_Delete -> fforCheap e $ \_ ->
-    ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
-  PatchMapWithMove.From_Move k -> fforCheap e $ \_ ->
-    ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Move k }
-  PatchMapWithMove.From_Insert ev -> leftmost
-    [ fforCheap ev $ \v ->
-        ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Insert v }
-    , fforCheap e $ \_ ->
-        ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
-    ]
+coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ fforCheap e $ \p -> if Map.null (unPatchMapWithMove p) then never else
+  let firingNewItems = mergeMap $ fforMaybe (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
+        PatchMapWithMove.From_Insert ev -> Just $ fforCheap ev $ \v ->
+          ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Insert v }
+        _ -> Nothing
+      oldItemMask = fforCheap e $ \_ -> ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
+        PatchMapWithMove.From_Delete ->
+          ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
+        PatchMapWithMove.From_Move k ->
+          ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Move k }
+        PatchMapWithMove.From_Insert _ ->
+          ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
+  in alignWith (mergeThese Map.union) firingNewItems oldItemMask -- Must be left-biased
 
 -- | Given a 'PatchTarget' of events (e.g., a 'Map' with 'Event' values) and an event of 'Patch'es
 -- (e.g., a 'PatchMap' with 'Event' values), produce an 'Event' of the 'PatchTarget' type that

From 64c5b7670dbab504008368c9fd503b0a32017b6a Mon Sep 17 00:00:00 2001
From: Ryan Trinkle <ryan@trinkle.org>
Date: Sun, 29 Sep 2019 11:55:11 -0400
Subject: [PATCH 14/34] Misc cleanups

---
 reflex.cabal                                |   2 +
 src/Data/List/Deferred.hs                   |  60 +++
 src/Data/List/NonEmpty/Deferred.hs          |  21 +-
 src/Data/List/NonEmpty/Deferred/Internal.hs |  30 ++
 src/Data/Unique/Tag/Local/Internal.hs       |   2 -
 src/Reflex/Class.hs                         |  16 +-
 src/Reflex/Dynamic.hs                       |   1 -
 src/Reflex/EventWriter/Base.hs              |  22 +-
 src/Reflex/PerformEvent/Base.hs             |  28 --
 src/Reflex/Profiled.hs                      |   1 -
 src/Reflex/Requester/Base/Internal.hs       | 486 +-------------------
 11 files changed, 122 insertions(+), 547 deletions(-)
 create mode 100644 src/Data/List/Deferred.hs
 create mode 100644 src/Data/List/NonEmpty/Deferred/Internal.hs

diff --git a/reflex.cabal b/reflex.cabal
index d7294017..3b276777 100644
--- a/reflex.cabal
+++ b/reflex.cabal
@@ -91,7 +91,9 @@ library
     Data.FastMutableIntMap,
     Data.FastWeakBag,
     Data.Functor.Misc,
+    Data.List.Deferred,
     Data.List.NonEmpty.Deferred,
+    Data.List.NonEmpty.Deferred.Internal,
     Data.Map.Misc,
     Data.TagMap,
     Data.Unique.Tag.Local,
diff --git a/src/Data/List/Deferred.hs b/src/Data/List/Deferred.hs
new file mode 100644
index 00000000..8c8c2424
--- /dev/null
+++ b/src/Data/List/Deferred.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE LambdaCase #-}
+module Data.List.Deferred
+  ( Deferred
+  , empty
+  , singleton
+  , toNonEmpty
+  , fromNonEmpty
+  , toList
+  ) where
+
+import Data.List.NonEmpty.Deferred.Internal (NonEmptyDeferred (..))
+import qualified Data.List.NonEmpty.Deferred as NonEmpty
+
+data Deferred a
+   = Deferred_Empty
+   | Deferred_Singleton a
+   | Deferred_Append !(NonEmptyDeferred a) !(NonEmptyDeferred a)
+
+{-# INLINE toNonEmpty #-}
+toNonEmpty :: Deferred a -> Maybe (NonEmptyDeferred a)
+toNonEmpty = \case
+  Deferred_Empty -> Nothing
+  Deferred_Singleton a -> Just $ NonEmpty.singleton a
+  Deferred_Append a b -> Just $ a <> b
+
+{-# INLINE fromNonEmpty #-}
+fromNonEmpty :: NonEmptyDeferred a -> Deferred a
+fromNonEmpty = \case
+  NonEmptyDeferred_Singleton a -> Deferred_Singleton a
+  NonEmptyDeferred_Append a b -> Deferred_Append a b
+
+{-# INLINE empty #-}
+empty :: Deferred a
+empty = Deferred_Empty
+
+{-# INLINE singleton #-}
+singleton :: a -> Deferred a
+singleton = fromNonEmpty . NonEmpty.singleton
+
+{-# INLINE toList #-}
+toList :: Deferred a -> [a]
+toList = \case
+  Deferred_Empty -> []
+  Deferred_Singleton a -> [a]
+  Deferred_Append a b -> NonEmpty.toList $ a <> b
+
+instance Semigroup (Deferred a) where
+  (<>) = \case
+    Deferred_Empty -> id
+    a@(Deferred_Singleton va) -> \case
+      Deferred_Empty -> a
+      Deferred_Singleton vb -> Deferred_Append (NonEmpty.singleton va) (NonEmpty.singleton vb)
+      Deferred_Append b1 b2 -> Deferred_Append (NonEmpty.singleton va) (b1 <> b2)
+    a@(Deferred_Append a1 a2) -> \case
+      Deferred_Empty -> a
+      Deferred_Singleton vb -> Deferred_Append (a1 <> a2) (NonEmpty.singleton vb)
+      Deferred_Append b1 b2 -> Deferred_Append (a1 <> a2) (b1 <> b2)
+
+instance Monoid (Deferred a) where
+  mempty = Deferred_Empty
diff --git a/src/Data/List/NonEmpty/Deferred.hs b/src/Data/List/NonEmpty/Deferred.hs
index 035f1119..322eeee7 100644
--- a/src/Data/List/NonEmpty/Deferred.hs
+++ b/src/Data/List/NonEmpty/Deferred.hs
@@ -7,24 +7,7 @@ module Data.List.NonEmpty.Deferred
   ( NonEmptyDeferred
   , singleton
   , toNonEmpty
+  , toList
   ) where
 
-import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.List.NonEmpty as NonEmpty
-
-data NonEmptyDeferred a
-   = NonEmptyDeferred_Singleton a
-   | NonEmptyDeferred_Append !(NonEmptyDeferred a) !(NonEmptyDeferred a)
-
-singleton :: a -> NonEmptyDeferred a
-singleton = NonEmptyDeferred_Singleton
-
-{-# INLINE toNonEmpty #-}
-toNonEmpty :: NonEmptyDeferred a -> NonEmpty a
-toNonEmpty = go []
-  where go t = \case
-          NonEmptyDeferred_Singleton a -> a :| t
-          NonEmptyDeferred_Append a b -> go (NonEmpty.toList $ go t b) a
-
-instance Semigroup (NonEmptyDeferred a) where
-  (<>) = NonEmptyDeferred_Append
+import Data.List.NonEmpty.Deferred.Internal
diff --git a/src/Data/List/NonEmpty/Deferred/Internal.hs b/src/Data/List/NonEmpty/Deferred/Internal.hs
new file mode 100644
index 00000000..09baa708
--- /dev/null
+++ b/src/Data/List/NonEmpty/Deferred/Internal.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE LambdaCase #-}
+module Data.List.NonEmpty.Deferred.Internal where
+
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NonEmpty
+
+data NonEmptyDeferred a
+   = NonEmptyDeferred_Singleton a
+   | NonEmptyDeferred_Append !(NonEmptyDeferred a) !(NonEmptyDeferred a)
+
+{-# INLINE singleton #-}
+singleton :: a -> NonEmptyDeferred a
+singleton = NonEmptyDeferred_Singleton
+
+{-# INLINE toNonEmpty #-}
+toNonEmpty :: NonEmptyDeferred a -> NonEmpty a
+toNonEmpty = go []
+  where go t = \case
+          NonEmptyDeferred_Singleton a -> a :| t
+          NonEmptyDeferred_Append a b -> go (NonEmpty.toList $ go t b) a
+
+{-# INLINE toList #-}
+toList :: NonEmptyDeferred a -> [a]
+toList = go []
+  where go t = \case
+          NonEmptyDeferred_Singleton a -> a : t
+          NonEmptyDeferred_Append a b -> go (go t b) a
+
+instance Semigroup (NonEmptyDeferred a) where
+  (<>) = NonEmptyDeferred_Append
diff --git a/src/Data/Unique/Tag/Local/Internal.hs b/src/Data/Unique/Tag/Local/Internal.hs
index 3164fe64..739e3883 100644
--- a/src/Data/Unique/Tag/Local/Internal.hs
+++ b/src/Data/Unique/Tag/Local/Internal.hs
@@ -12,9 +12,7 @@
 {-# LANGUAGE MagicHash #-}
 module Data.Unique.Tag.Local.Internal where
 
-import Control.Monad.Exception
 import Control.Monad.Primitive
-import Control.Monad.Reader
 import Data.Primitive.MutVar
 import Data.GADT.Compare
 import Data.Some
diff --git a/src/Reflex/Class.hs b/src/Reflex/Class.hs
index ca62e5d5..39faaa9c 100644
--- a/src/Reflex/Class.hs
+++ b/src/Reflex/Class.hs
@@ -170,6 +170,7 @@ module Reflex.Class
   , mergeWithCheap
   , mergeWithCheap'
   , sconcatCheap
+  , mconcatCheap
     -- * Slow, but general, implementations
   , slowHeadE
   ) where
@@ -208,6 +209,7 @@ import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IntMap
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Map (Map)
+import qualified Data.Map as Map
 import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
 import Data.Some (Some(Some))
 import Data.String
@@ -733,11 +735,6 @@ instance Reflex t => Functor (Event t) where
   {-# INLINE (<$) #-}
   x <$ e = fmapCheap (const x) e
 
--- TODO Remove this instance
-instance Reflex t => FunctorMaybe (Event t) where
-  {-# INLINE fmapMaybe #-}
-  fmapMaybe = mapMaybe
-
 instance Reflex t => Filterable (Event t) where
   {-# INLINE mapMaybe #-}
   mapMaybe f = push $ return . f
@@ -894,6 +891,9 @@ instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
 sconcatCheap :: (Semigroup a, Reflex t) => NonEmpty (Event t a) -> Event t a
 sconcatCheap = fmapCheap sconcat . mergeList . toList
 
+mconcatCheap :: (Semigroup a, Reflex t) => [Event t a] -> Event t a
+mconcatCheap = fmapCheap sconcat . mergeList
+
 instance (Semigroup a, Reflex t) => Monoid (Event t a) where
   mempty = never
   mappend = (<>)
@@ -1664,7 +1664,7 @@ mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f
 -- | A "cheap" version of 'mergeWithFoldCheap''. See the performance note on 'pushCheap'.
 {-# INLINE mergeWithFoldCheap' #-}
 mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b
-mergeWithFoldCheap' f [] = never
+mergeWithFoldCheap' _ [] = never
 mergeWithFoldCheap' f [e] = fmapCheap (f . (:|[])) e
 mergeWithFoldCheap' f es =
   fmapCheap (f . (\(h : t) -> h :| t) . IntMap.elems)
@@ -1691,3 +1691,7 @@ switchPromptOnly = switchHoldPromptOnly
 mergeIntMap :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)
 mergeIntMap = mergeInt
 
+-- NOTE: A deprecation warning is expected on this instance
+instance Reflex t => FunctorMaybe (Event t) where
+  {-# INLINE fmapMaybe #-}
+  fmapMaybe = mapMaybe
diff --git a/src/Reflex/Dynamic.hs b/src/Reflex/Dynamic.hs
index 0a516b9a..e041d06a 100644
--- a/src/Reflex/Dynamic.hs
+++ b/src/Reflex/Dynamic.hs
@@ -80,7 +80,6 @@ import Data.Functor.Compose
 import Data.Functor.Misc
 import Reflex.Class
 
-import Control.Monad
 import Control.Monad.Fix
 import Control.Monad.Identity
 import Data.Align
diff --git a/src/Reflex/EventWriter/Base.hs b/src/Reflex/EventWriter/Base.hs
index 0243730d..03940ca6 100644
--- a/src/Reflex/EventWriter/Base.hs
+++ b/src/Reflex/EventWriter/Base.hs
@@ -39,37 +39,34 @@ import Control.Monad.Primitive
 import Control.Monad.Reader
 import Control.Monad.Ref
 import Control.Monad.State.Strict
-import Data.Dependent.Map (DMap, DSum (..))
+import Data.Dependent.Map (DMap)
 import qualified Data.Dependent.Map as DMap
 import Data.Functor.Compose
 import Data.Functor.Misc
-import Data.GADT.Compare (GCompare (..), GEq (..), GOrdering (..))
+import Data.GADT.Compare (GCompare (..))
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IntMap
 import Data.List.NonEmpty (NonEmpty (..))
-import Data.List.NonEmpty.Deferred (NonEmptyDeferred)
-import qualified Data.List.NonEmpty.Deferred as NonEmptyDeferred
+import Data.List.Deferred (Deferred)
+import qualified Data.List.Deferred as Deferred
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Semigroup
 import Data.Some (Some)
 import Data.Tuple
-import Data.Type.Equality
-
-type EventWriterState t w = Maybe (NonEmptyDeferred (Event t w))
 
 -- | A basic implementation of 'EventWriter'.
-newtype EventWriterT t w m a = EventWriterT { unEventWriterT :: StateT (EventWriterState t w) m a }
+newtype EventWriterT t w m a = EventWriterT { unEventWriterT :: StateT (Deferred (Event t w)) m a }
   deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException, MonadAsyncException)
 
 -- | Run a 'EventWriterT' action.
 runEventWriterT :: forall t m w a. (Reflex t, Monad m, Semigroup w) => EventWriterT t w m a -> m (a, Event t w)
 runEventWriterT (EventWriterT a) = do
-  (result, requests) <- runStateT a Nothing
-  return (result, maybe never (sconcatCheap . NonEmptyDeferred.toNonEmpty) requests)
+  (result, requests) <- runStateT a mempty
+  return (result, mconcatCheap $ Deferred.toList requests)
 
 instance (Reflex t, Monad m, Semigroup w) => EventWriter t w (EventWriterT t w m) where
-  tellEvent w = EventWriterT $ modify (<> Just (NonEmptyDeferred.singleton w))
+  tellEvent w = EventWriterT $ modify (<> Deferred.singleton w)
 
 instance MonadTrans (EventWriterT t w) where
   lift = EventWriterT . lift
@@ -155,9 +152,6 @@ sequenceIntMapWithAdjustEventWriterTWith base mergePatchIncremental coincidenceP
       h : t -> Just $ sconcat $ h :| t
   return (result0, result')
 
-switchHoldPromptOnlyIntMapIncremental :: (Reflex t, MonadHold t m) => IntMap (Event t a) -> Event t (PatchIntMap (Event t a)) -> m (Event t (IntMap a))
-switchHoldPromptOnlyIntMapIncremental = switchHoldPromptOnlyIncremental mergeIntIncremental coincidencePatchIntMap
-
 -- | Like 'runWithReplaceEventWriterTWith', but for 'sequenceDMapWithAdjust'.
 sequenceDMapWithAdjustEventWriterTWith
   :: forall t m p p' w k v v'
diff --git a/src/Reflex/PerformEvent/Base.hs b/src/Reflex/PerformEvent/Base.hs
index 33b08c91..e749e05d 100644
--- a/src/Reflex/PerformEvent/Base.hs
+++ b/src/Reflex/PerformEvent/Base.hs
@@ -42,22 +42,18 @@ import Control.Monad.Ref
 import Data.Dependent.Map (DMap)
 import qualified Data.Dependent.Map as DMap
 import Data.Dependent.Sum
-import Data.Foldable
 import Data.Functor.Compose
 import Data.Functor.Misc
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IntMap
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.List.NonEmpty.Deferred (NonEmptyDeferred)
-import qualified Data.List.NonEmpty.Deferred as NonEmptyDeferred
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Semigroup (Semigroup (sconcat))
 import qualified Data.Semigroup as S
 import Data.Unique.Tag.Local
-import Data.Sequence (Seq)
 import Data.Tuple
-import qualified Data.TagMap as TagMap
 
 -- | A function that fires events for the given 'EventTrigger's and then runs
 -- any followup actions provided via 'PerformEvent'.  The given 'ReadPhase'
@@ -159,28 +155,6 @@ concatMapMaybe m = case Map.elems m of
   [] -> Nothing
   h : t -> Just $ sconcat $ h :| t
 
-defaultAdjustBase :: forall t v v2 k' p. (Monad (HostFrame t), PrimMonad (HostFrame t), Reflex t)
-  => ((forall a. k' a -> v a -> HostFrame t (v2 a)) -> p k' v -> HostFrame t (p k' v2))
-  -> (forall a. k' a -> v a -> HostFrame t (v2 a))
-  -> DMap k' v
-  -> Event t (p k' v)
-  -> RequesterT t (HostFrame t) Identity (HostFrame t) (DMap k' v2, Event t (p k' v2))
-defaultAdjustBase traversePatchWithKey f' dm0 dm' = do
-  result0 <- lift $ DMap.traverseWithKey f' dm0
-  result' <- requestingIdentity $ ffor dm' $ traversePatchWithKey f'
-  return (result0, result')
-
-defaultAdjustIntBase :: forall t v v2 p. (Monad (HostFrame t), PrimMonad (HostFrame t), Reflex t)
-  => ((IntMap.Key -> v -> HostFrame t v2) -> p v -> HostFrame t (p v2))
-  -> (IntMap.Key -> v -> HostFrame t v2)
-  -> IntMap v
-  -> Event t (p v)
-  -> RequesterT t (HostFrame t) Identity (HostFrame t) (IntMap v2, Event t (p v2))
-defaultAdjustIntBase traversePatchWithKey f' dm0 dm' = do
-  result0 <- lift $ IntMap.traverseWithKey f' dm0
-  result' <- requestingIdentity $ ffor dm' $ traversePatchWithKey f'
-  return (result0, result')
-
 instance ReflexHost t => MonadReflexCreateTrigger t (PerformEventT t m) where
   {-# INLINABLE newEventWithTrigger #-}
   newEventWithTrigger = PerformEventT . lift . newEventWithTrigger
@@ -216,8 +190,6 @@ hostPerformEventT a = do
             Nothing -> return [result']
             Just toPerform -> do
               responses <- runHostFrame $ traverseRequesterData (Identity <$>) toPerform
-              let responseLength = case responses of
-                    ResponseData _ m -> TagMap.size m
               mrt <- readRef responseTrigger
               let followupEventTriggers = case mrt of
                     Just rt -> [rt :=> Identity responses]
diff --git a/src/Reflex/Profiled.hs b/src/Reflex/Profiled.hs
index db9aa829..ad4c0d5e 100644
--- a/src/Reflex/Profiled.hs
+++ b/src/Reflex/Profiled.hs
@@ -47,7 +47,6 @@ import Reflex.Host.Class
 import Reflex.PerformEvent.Class
 
 import System.IO.Unsafe
-import Unsafe.Coerce
 
 data ProfiledTimeline t
 
diff --git a/src/Reflex/Requester/Base/Internal.hs b/src/Reflex/Requester/Base/Internal.hs
index fc4d6699..d0fa81d7 100644
--- a/src/Reflex/Requester/Base/Internal.hs
+++ b/src/Reflex/Requester/Base/Internal.hs
@@ -21,7 +21,6 @@ module Reflex.Requester.Base.Internal where
 
 import Reflex.Class
 import Reflex.Adjustable.Class
-import Reflex.Dynamic
 import Reflex.Host.Class
 import Reflex.PerformEvent.Class
 import Reflex.PostBuild.Class
@@ -36,35 +35,21 @@ import Control.Monad.Identity
 import Control.Monad.Primitive
 import Control.Monad.Reader
 import Control.Monad.Ref
-import Control.Monad.State.Strict
-import Data.Bits
 import Data.Coerce
-import Data.Dependent.Map (DMap, DSum (..))
-import qualified Data.Dependent.Map as DMap
-import Data.Functor.Compose
-import Data.Functor.Misc
-import Data.IntMap.Strict (IntMap)
-import qualified Data.IntMap.Strict as IntMap
+import Data.Dependent.Map (DSum (..))
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.List.NonEmpty.Deferred (NonEmptyDeferred)
 import qualified Data.List.NonEmpty.Deferred as NonEmptyDeferred
-import Data.Map (Map)
-import qualified Data.Map as Map
 import Data.Monoid ((<>))
-import Data.Proxy
 import qualified Data.Semigroup as S
 import Data.Some (Some(Some))
 import Data.Type.Equality
-import Data.Sequence (Seq)
-import qualified Data.Sequence as Seq
 import Data.TagMap (TagMap)
 import qualified Data.TagMap as TagMap
 import Reflex.FanTag
 import Data.Unique.Tag.Local
-import qualified Data.Unique.Tag as Global
 import Data.GADT.Compare
 import Data.Witherable
-import Data.Foldable
 
 import Unsafe.Coerce
 
@@ -137,21 +122,21 @@ newtype RequesterInternalT s t request response m a = RequesterInternalT { unReq
 #endif
     )
 
--- I don't think this can actually be supported without an unsafeCoerce
+-- I don't think this can actually be supported without unsafeCoercing around the fact that the phantoms don't match up.  In fact, implementations could probably supply `unmask` functions that would actually do the wrong thing.
 -- #if MIN_VERSION_base(4,9,1)
 -- instance MonadAsyncException m => MonadAsyncException (RequesterT t request response m) where
 --   mask f = RequesterT $ mask $ \unmask -> unRequesterT $ f $ \x -> RequesterT $ unmask $ unRequesterT x
 -- #endif
 
-instance MonadSample t m => MonadSample t (RequesterT t request response m)
-instance MonadHold t m => MonadHold t (RequesterT t request response m)
-instance PostBuild t m => PostBuild t (RequesterT t request response m)
-instance TriggerEvent t m => TriggerEvent t (RequesterT t request response m)
+deriving instance MonadSample t m => MonadSample t (RequesterT t request response m)
+deriving instance MonadHold t m => MonadHold t (RequesterT t request response m)
+deriving instance PostBuild t m => PostBuild t (RequesterT t request response m)
+deriving instance TriggerEvent t m => TriggerEvent t (RequesterT t request response m)
 
-instance MonadSample t m => MonadSample t (RequesterInternalT s t request response m)
-instance MonadHold t m => MonadHold t (RequesterInternalT s t request response m)
-instance PostBuild t m => PostBuild t (RequesterInternalT s t request response m)
-instance TriggerEvent t m => TriggerEvent t (RequesterInternalT s t request response m)
+deriving instance MonadSample t m => MonadSample t (RequesterInternalT s t request response m)
+deriving instance MonadHold t m => MonadHold t (RequesterInternalT s t request response m)
+deriving instance PostBuild t m => PostBuild t (RequesterInternalT s t request response m)
+deriving instance TriggerEvent t m => TriggerEvent t (RequesterInternalT s t request response m)
 
 instance PrimMonad m => PrimMonad (RequesterT t request response m) where
   type PrimState (RequesterT t request response m) = PrimState m
@@ -221,454 +206,3 @@ instance (Adjustable t m, MonadHold t m) => Adjustable t (RequesterT t request r
   traverseDMapWithKeyWithAdjust f dm0 dm' = RequesterT $ traverseDMapWithKeyWithAdjust (\k v -> unRequesterT $ f k v) dm0 dm'
   {-# INLINE traverseDMapWithKeyWithAdjustWithMove #-}
   traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = RequesterT $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unRequesterT $ f k v) dm0 dm'
-
-{-
-import GHC.Exts (Any)
-import Unsafe.Coerce
-
---TODO: Make this module type-safe
-
-newtype TagMap (f :: * -> *) = TagMap (IntMap Any)
-
-newtype RequesterData f = RequesterData (TagMap (Entry f))
-
-data RequesterDataKey a where
-  RequesterDataKey_Single :: {-# UNPACK #-} !(MyTag (Single a)) -> RequesterDataKey a
-  RequesterDataKey_Multi :: {-# UNPACK #-} !(MyTag Multi) -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a --TODO: Don't put a second Int here (or in the other Multis); use a single Int instead
-  RequesterDataKey_Multi2 :: {-# UNPACK #-} !(MyTag (Multi2 k)) -> !(Some k) -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a
-  RequesterDataKey_Multi3 :: {-# UNPACK #-} !(MyTag Multi3) -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a
-
-singletonRequesterData :: RequesterDataKey a -> f a -> RequesterData f
-singletonRequesterData rdk v = case rdk of
-  RequesterDataKey_Single k -> RequesterData $ singletonTagMap k $ Entry v
-  RequesterDataKey_Multi k k' k'' -> RequesterData $ singletonTagMap k $ Entry $ IntMap.singleton k' $ singletonRequesterData k'' v
-  RequesterDataKey_Multi2 k k' k'' k''' -> RequesterData $ singletonTagMap k $ Entry $ Map.singleton k' $ IntMap.singleton k'' $ singletonRequesterData k''' v
-  RequesterDataKey_Multi3 k k' k'' k''' -> RequesterData $ singletonTagMap k $ Entry $ IntMap.singleton k' $ IntMap.singleton k'' $ singletonRequesterData k''' v
-
-requesterDataToList :: RequesterData f -> [DSum RequesterDataKey f]
-requesterDataToList (RequesterData m) = do
-  k :=> Entry e <- tagMapToList m
-  case myKeyType k of
-    MyTagType_Single -> return $ RequesterDataKey_Single k :=> e
-    MyTagType_Multi -> do
-      (k', e') <- IntMap.toList e
-      k'' :=> e'' <- requesterDataToList e'
-      return $ RequesterDataKey_Multi k k' k'' :=> e''
-    MyTagType_Multi2 -> do
-      (k', e') <- Map.toList e
-      (k'', e'') <- IntMap.toList e'
-      k''' :=> e''' <- requesterDataToList e''
-      return $ RequesterDataKey_Multi2 k k' k'' k''' :=> e'''
-    MyTagType_Multi3 -> do
-      (k', e') <- IntMap.toList e
-      (k'', e'') <- IntMap.toList e'
-      k''' :=> e''' <- requesterDataToList e''
-      return $ RequesterDataKey_Multi3 k k' k'' k''' :=> e'''
-
-singletonTagMap :: forall f a. MyTag a -> f a -> TagMap f
-singletonTagMap (MyTag k) v = TagMap $ IntMap.singleton k $ (unsafeCoerce :: f a -> Any) v
-
-tagMapToList :: forall f. TagMap f -> [DSum MyTag f]
-tagMapToList (TagMap m) = f <$> IntMap.toList m
-  where f :: (Int, Any) -> DSum MyTag f
-        f (k, v) = MyTag k :=> (unsafeCoerce :: Any -> f a) v
-
-traverseTagMapWithKey :: forall t f g. Applicative t => (forall a. MyTag a -> f a -> t (g a)) -> TagMap f -> t (TagMap g)
-traverseTagMapWithKey f (TagMap m) = TagMap <$> IntMap.traverseWithKey g m
-  where
-    g :: Int -> Any -> t Any
-    g k v = (unsafeCoerce :: g a -> Any) <$> f (MyTag k) ((unsafeCoerce :: Any -> f a) v)
-
--- | Runs in reverse to accommodate for the fact that we accumulate it in reverse
-traverseRequesterData :: forall m request response. Applicative m => (forall a. request a -> m (response a)) -> RequesterData request -> m (RequesterData response)
-traverseRequesterData f (RequesterData m) = RequesterData <$> traverseTagMapWithKey go m --TODO: reverse this, since our tags are in reverse order
-  where go :: forall x. MyTag x -> Entry request x -> m (Entry response x)
-        go k (Entry request) = Entry <$> case myKeyType k of
-          MyTagType_Single -> f request
-          MyTagType_Multi -> traverse (traverseRequesterData f) request
-          MyTagType_Multi2 -> traverse (traverse (traverseRequesterData f)) request
-          MyTagType_Multi3 -> traverse (traverse (traverseRequesterData f)) request
-
--- | 'traverseRequesterData' with its arguments flipped
-forRequesterData :: forall request response m. Applicative m => RequesterData request -> (forall a. request a -> m (response a)) -> m (RequesterData response)
-forRequesterData r f = traverseRequesterData f r
-
-data MyTagType :: * -> * where
-  MyTagType_Single :: MyTagType (Single a)
-  MyTagType_Multi :: MyTagType Multi
-  MyTagType_Multi2 :: MyTagType (Multi2 k)
-  MyTagType_Multi3 :: MyTagType Multi3
-
-myKeyType :: MyTag x -> MyTagType x
-myKeyType (MyTag k) = case k .&. 0x3 of
-  0x0 -> unsafeCoerce MyTagType_Single
-  0x1 -> unsafeCoerce MyTagType_Multi
-  0x2 -> unsafeCoerce MyTagType_Multi2
-  0x3 -> unsafeCoerce MyTagType_Multi3
-  t -> error $ "Reflex.Requester.Base.myKeyType: no such key type" <> show t
-
-data Single a
-data Multi
-data Multi2 (k :: * -> *)
-data Multi3
-
-class MyTagTypeOffset x where
-  myTagTypeOffset :: proxy x -> Int
-
-instance MyTagTypeOffset (Single a) where
-  myTagTypeOffset _ = 0x0
-
-instance MyTagTypeOffset Multi where
-  myTagTypeOffset _ = 0x1
-
-instance MyTagTypeOffset (Multi2 k) where
-  myTagTypeOffset _ = 0x2
-
-instance MyTagTypeOffset Multi3 where
-  myTagTypeOffset _ = 0x3
-
-type family EntryContents request a where
-  EntryContents request (Single a) = request a
-  EntryContents request Multi = IntMap (RequesterData request)
-  EntryContents request (Multi2 k) = Map (Some k) (IntMap (RequesterData request))
-  EntryContents request Multi3 = IntMap (IntMap (RequesterData request))
-
-newtype Entry request x = Entry { unEntry :: EntryContents request x }
-
-{-# INLINE singleEntry #-}
-singleEntry :: f a -> Entry f (Single a)
-singleEntry = Entry
-
-{-# INLINE multiEntry #-}
-multiEntry :: IntMap (RequesterData f) -> Entry f Multi
-multiEntry = Entry
-
-{-# INLINE unMultiEntry #-}
-unMultiEntry :: Entry f Multi -> IntMap (RequesterData f)
-unMultiEntry = unEntry
-
--- | We use a hack here to pretend we have x ~ request a; we don't want to use a GADT, because GADTs (even with zero-size existential contexts) can't be newtypes
--- WARNING: This type should never be exposed.  In particular, this is extremely unsound if a MyTag from one run of runRequesterT is ever compared against a MyTag from another
-newtype MyTag x = MyTag Int deriving (Show, Eq, Ord, Enum)
-
-newtype MyTagWrap (f :: * -> *) x = MyTagWrap Int deriving (Show, Eq, Ord, Enum)
-
-{-# INLINE castMyTagWrap #-}
-castMyTagWrap :: MyTagWrap f (Entry f x) -> MyTagWrap g (Entry g x)
-castMyTagWrap = coerce
-
-instance GEq MyTag where
-  (MyTag a) `geq` (MyTag b) =
-    if a == b
-    then Just $ unsafeCoerce Refl
-    else Nothing
-
-instance GCompare MyTag where
-  (MyTag a) `gcompare` (MyTag b) =
-    case a `compare` b of
-      LT -> GLT
-      EQ -> unsafeCoerce GEQ
-      GT -> GGT
-
-instance GEq (MyTagWrap f) where
-  (MyTagWrap a) `geq` (MyTagWrap b) =
-    if a == b
-    then Just $ unsafeCoerce Refl
-    else Nothing
-
-instance GCompare (MyTagWrap f) where
-  (MyTagWrap a) `gcompare` (MyTagWrap b) =
-    case a `compare` b of
-      LT -> GLT
-      EQ -> unsafeCoerce GEQ
-      GT -> GGT
-
-data RequesterState t (request :: * -> *) = RequesterState
-  { _requesterState_nextMyTag :: {-# UNPACK #-} !Int -- Starts at -4 and goes down by 4 each time, to accommodate two 'type' bits at the bottom
-  , _requesterState_requests :: ![(Int, Event t Any)]
-  }
-
--- | A basic implementation of 'Requester'.
-newtype RequesterT t request (response :: * -> *) m a = RequesterT { unRequesterT :: StateT (RequesterState t request) (ReaderT (EventSelectorInt t Any) m) a }
-  deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException
--- MonadAsyncException can't be derived on ghc-8.0.1; we use base-4.9.1 as a proxy for ghc-8.0.2
-#if MIN_VERSION_base(4,9,1)
-           , MonadAsyncException
-#endif
-           )
-
-
--- | Run a 'RequesterT' action.  The resulting 'Event' will fire whenever
--- requests are made, and responses should be provided in the input 'Event'.
--- The 'Tag' keys will be used to return the responses to the same place the
--- requests were issued.
-runRequesterT :: (Reflex t, Monad m)
-              => RequesterT t request response m a
-              -> Event t (RequesterData response) --TODO: This DMap will be in reverse order, so we need to make sure the caller traverses it in reverse
-              -> m (a, Event t (RequesterData request)) --TODO: we need to hide these 'MyTag's here, because they're unsafe to mix in the wild
-runRequesterT (RequesterT a) responses = do
-  (result, s) <- runReaderT (runStateT a $ RequesterState (-4) []) $ fanInt $
-    coerceEvent responses
-  return (result, fmapCheap (RequesterData . TagMap) $ mergeInt $ IntMap.fromDistinctAscList $ _requesterState_requests s)
-
--- | Map a function over the request and response of a 'RequesterT'
-withRequesterT
-  :: (Reflex t, MonadFix m)
-  => (forall x. req x -> req' x) -- ^ The function to map over the request
-  -> (forall x. rsp' x -> rsp x) -- ^ The function to map over the response
-  -> RequesterT t req rsp m a -- ^ The internal 'RequesterT' whose input and output will be transformed
-  -> RequesterT t req' rsp' m a -- ^ The resulting 'RequesterT'
-withRequesterT freq frsp child = do
-  rec let rsp = fmap (runIdentity . traverseRequesterData (Identity . frsp)) rsp'
-      (a, req) <- lift $ runRequesterT child rsp
-      rsp' <- fmap (flip selectInt 0 . fanInt . fmapCheap unMultiEntry) $ requesting' $
-        fmapCheap (multiEntry . IntMap.singleton 0) $ fmap (runIdentity . traverseRequesterData (Identity . freq)) req
-  return a
-
-instance (Reflex t, Monad m) => Requester t (RequesterT t request response m) where
-  type Request (RequesterT t request response m) = request
-  type Response (RequesterT t request response m) = response
-  requesting = fmap coerceEvent . responseFromTag . castMyTagWrap <=< tagRequest . (coerceEvent :: Event t (request a) -> Event t (Entry request (Single a)))
-  requesting_ = void . tagRequest . fmapCheap singleEntry
-
-{-# INLINE tagRequest #-}
-tagRequest :: forall m x t request response. (Monad m, MyTagTypeOffset x) => Event t (Entry request x) -> RequesterT t request response m (MyTagWrap request (Entry request x))
-tagRequest req = do
-  old <- RequesterT get
-  let n = _requesterState_nextMyTag old .|. myTagTypeOffset (Proxy :: Proxy x)
-      t = MyTagWrap n
-  RequesterT $ put $ RequesterState
-    { _requesterState_nextMyTag = _requesterState_nextMyTag old - 0x4
-    , _requesterState_requests = (n, (unsafeCoerce :: Event t (Entry request x) -> Event t Any) req) : _requesterState_requests old
-    }
-  return t
-
-{-# INLINE responseFromTag #-}
-responseFromTag :: Monad m => MyTagWrap response (Entry response x) -> RequesterT t request response m (Event t (Entry response x))
-responseFromTag (MyTagWrap t) = do
-  responses :: EventSelectorInt t Any <- RequesterT ask
-  return $ (unsafeCoerce :: Event t Any -> Event t (Entry response x)) $ selectInt responses t
-
-instance MonadTrans (RequesterT t request response) where
-  lift = RequesterT . lift . lift
-
-instance PerformEvent t m => PerformEvent t (RequesterT t request response m) where
-  type Performable (RequesterT t request response m) = Performable m
-  performEvent_ = lift . performEvent_
-  performEvent = lift . performEvent
-
-instance MonadRef m => MonadRef (RequesterT t request response m) where
-  type Ref (RequesterT t request response m) = Ref m
-  newRef = lift . newRef
-  readRef = lift . readRef
-  writeRef r = lift . writeRef r
-
-instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (RequesterT t request response m) where
-  newEventWithTrigger = lift . newEventWithTrigger
-  newFanEventWithTrigger f = lift $ newFanEventWithTrigger f
-
-instance MonadReader r m => MonadReader r (RequesterT t request response m) where
-  ask = lift ask
-  local f (RequesterT a) = RequesterT $ mapStateT (mapReaderT $ local f) a
-  reader = lift . reader
-
-instance (Reflex t, Adjustable t m, MonadHold t m, MonadFix m) => Adjustable t (RequesterT t request response m) where
-  runWithReplace = runWithReplaceRequesterTWith $ \dm0 dm' -> lift $ runWithReplace dm0 dm'
-  traverseIntMapWithKeyWithAdjust = traverseIntMapWithKeyWithAdjustRequesterTWith (\f dm0 dm' -> lift $ traverseIntMapWithKeyWithAdjust f dm0 dm') patchIntMapNewElementsMap mergeIntIncremental
-  {-# INLINABLE traverseDMapWithKeyWithAdjust #-}
-  traverseDMapWithKeyWithAdjust = traverseDMapWithKeyWithAdjustRequesterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjust f dm0 dm') mapPatchDMap weakenPatchDMapWith patchMapNewElementsMap mergeMapIncremental
-  traverseDMapWithKeyWithAdjustWithMove = traverseDMapWithKeyWithAdjustRequesterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjustWithMove f dm0 dm') mapPatchDMapWithMove weakenPatchDMapWithMoveWith patchMapWithMoveNewElementsMap mergeMapIncrementalWithMove
-
-requesting' :: (MyTagTypeOffset x, Monad m) => Event t (Entry request x) -> RequesterT t request response m (Event t (Entry response x))
-requesting' = responseFromTag . castMyTagWrap <=< tagRequest
-
-{-# INLINABLE runWithReplaceRequesterTWith #-}
-runWithReplaceRequesterTWith :: forall m t request response a b. (Reflex t, MonadHold t m
-                                                                 , MonadFix m
-                                                                 )
-                             => (forall a' b'. m a' -> Event t (m b') -> RequesterT t request response m (a', Event t b'))
-                             -> RequesterT t request response m a
-                             -> Event t (RequesterT t request response m b)
-                             -> RequesterT t request response m (a, Event t b)
-runWithReplaceRequesterTWith f a0 a' = do
-  rec na' <- numberOccurrencesFrom 1 a'
-      responses <- fmap (fmapCheap unMultiEntry) $ requesting' $ fmapCheap multiEntry $ switchPromptlyDyn requests --TODO: Investigate whether we can really get rid of the prompt stuff here
-      let responses' = fanInt responses
-      ((result0, requests0), v') <- f (runRequesterT a0 (selectInt responses' 0)) $ fmapCheap (\(n, a) -> fmap ((,) n) $ runRequesterT a $ selectInt responses' n) na'
-      requests <- holdDyn (fmapCheap (IntMap.singleton 0) requests0) $ fmapCheap (\(n, (_, reqs)) -> fmapCheap (IntMap.singleton n) reqs) v'
-  return (result0, fmapCheap (fst . snd) v')
-
-{-# INLINE traverseIntMapWithKeyWithAdjustRequesterTWith #-}
-traverseIntMapWithKeyWithAdjustRequesterTWith :: forall t request response m v v' p.
-                                        ( Reflex t
-                                        , MonadHold t m
-                                        , PatchTarget (p (Event t (IntMap (RequesterData request)))) ~ IntMap (Event t (IntMap (RequesterData request)))
-                                        , Patch (p (Event t (IntMap (RequesterData request))))
-                                        , Functor p
-                                        , MonadFix m
-                                        )
-                                     => (   (IntMap.Key -> (IntMap.Key, v) -> m (Event t (IntMap (RequesterData request)), v'))
-                                         -> IntMap (IntMap.Key, v)
-                                         -> Event t (p (IntMap.Key, v))
-                                         -> RequesterT t request response m (IntMap (Event t (IntMap (RequesterData request)), v'), Event t (p (Event t (IntMap (RequesterData request)), v')))
-                                        )
-                                     -> (p (Event t (IntMap (RequesterData request))) -> IntMap (Event t (IntMap (RequesterData request))))
-                                     -> (Incremental t (p (Event t (IntMap (RequesterData request)))) -> Event t (IntMap (IntMap (RequesterData request))))
-                                     -> (IntMap.Key -> v -> RequesterT t request response m v')
-                                     -> IntMap v
-                                     -> Event t (p v)
-                                     -> RequesterT t request response m (IntMap v', Event t (p v'))
-traverseIntMapWithKeyWithAdjustRequesterTWith base patchNewElements mergePatchIncremental f dm0 dm' = do
-  rec response <- requesting' $ fmapCheap pack $ promptRequests `mappend` mergePatchIncremental requests --TODO: Investigate whether we can really get rid of the prompt stuff here
-      let responses :: EventSelectorInt t (IntMap (RequesterData response))
-          responses = fanInt $ fmapCheap unpack response
-          unpack :: Entry response Multi3 -> IntMap (IntMap (RequesterData response))
-          unpack = unEntry
-          pack :: IntMap (IntMap (RequesterData request)) -> Entry request Multi3
-          pack = Entry
-          f' :: IntMap.Key -> (Int, v) -> m (Event t (IntMap (RequesterData request)), v')
-          f' k (n, v) = do
-            (result, myRequests) <- runRequesterT (f k v) $ mapMaybeCheap (IntMap.lookup n) $ selectInt responses k --TODO: Instead of doing mapMaybeCheap, can we share a fanInt across all instances of a given key, or at least the ones that are adjacent in time?
-            return (fmapCheap (IntMap.singleton n) myRequests, result)
-      ndm' <- numberOccurrencesFrom 1 dm'
-      (children0, children') <- base f' (fmap ((,) 0) dm0) $ fmap (\(n, dm) -> fmap ((,) n) dm) ndm' --TODO: Avoid this somehow, probably by adding some sort of per-cohort information passing to Adjustable
-      let result0 = fmap snd children0
-          result' = fforCheap children' $ fmap snd
-          requests0 :: IntMap (Event t (IntMap (RequesterData request)))
-          requests0 = fmap fst children0
-          requests' :: Event t (p (Event t (IntMap (RequesterData request))))
-          requests' = fforCheap children' $ fmap fst
-          promptRequests :: Event t (IntMap (IntMap (RequesterData request)))
-          promptRequests = coincidence $ fmapCheap (mergeInt . patchNewElements) requests' --TODO: Create a mergeIncrementalPromptly, and use that to eliminate this 'coincidence'
-      requests <- holdIncremental requests0 requests'
-  return (result0, result')
-
-{-# INLINE traverseDMapWithKeyWithAdjustRequesterTWith #-}
-traverseDMapWithKeyWithAdjustRequesterTWith :: forall k t request response m v v' p p'.
-                                        ( GCompare k
-                                        , Reflex t
-                                        , MonadHold t m
-                                        , PatchTarget (p' (Some k) (Event t (IntMap (RequesterData request)))) ~ Map (Some k) (Event t (IntMap (RequesterData request)))
-                                        , Patch (p' (Some k) (Event t (IntMap (RequesterData request))))
-                                        , MonadFix m
-                                        )
-                                     => (forall k' v1 v2. GCompare k'
-                                         => (forall a. k' a -> v1 a -> m (v2 a))
-                                         -> DMap k' v1
-                                         -> Event t (p k' v1)
-                                         -> RequesterT t request response m (DMap k' v2, Event t (p k' v2))
-                                        )
-                                     -> (forall v1 v2. (forall a. v1 a -> v2 a) -> p k v1 -> p k v2)
-                                     -> (forall v1 v2. (forall a. v1 a -> v2) -> p k v1 -> p' (Some k) v2)
-                                     -> (forall v2. p' (Some k) v2 -> Map (Some k) v2)
-                                     -> (forall a. Incremental t (p' (Some k) (Event t a)) -> Event t (Map (Some k) a))
-                                     -> (forall a. k a -> v a -> RequesterT t request response m (v' a))
-                                     -> DMap k v
-                                     -> Event t (p k v)
-                                     -> RequesterT t request response m (DMap k v', Event t (p k v'))
-traverseDMapWithKeyWithAdjustRequesterTWith base mapPatch weakenPatchWith patchNewElements mergePatchIncremental f dm0 dm' = do
-  rec response <- requesting' $ fmapCheap pack $ promptRequests `mappend` mergePatchIncremental requests --TODO: Investigate whether we can really get rid of the prompt stuff here
-      let responses :: EventSelector t (Const2 (Some k) (IntMap (RequesterData response)))
-          responses = fanMap $ fmapCheap unpack response
-          unpack :: Entry response (Multi2 k) -> Map (Some k) (IntMap (RequesterData response))
-          unpack = unEntry
-          pack :: Map (Some k) (IntMap (RequesterData request)) -> Entry request (Multi2 k)
-          pack = Entry
-          f' :: forall a. k a -> Compose ((,) Int) v a -> m (Compose ((,) (Event t (IntMap (RequesterData request)))) v' a)
-          f' k (Compose (n, v)) = do
-            (result, myRequests) <- runRequesterT (f k v) $ mapMaybeCheap (IntMap.lookup n) $ select responses (Const2 (Some k))
-            return $ Compose (fmapCheap (IntMap.singleton n) myRequests, result)
-      ndm' <- numberOccurrencesFrom 1 dm'
-      (children0, children') <- base f' (DMap.map (\v -> Compose (0, v)) dm0) $ fmap (\(n, dm) -> mapPatch (\v -> Compose (n, v)) dm) ndm'
-      let result0 = DMap.map (snd . getCompose) children0
-          result' = fforCheap children' $ mapPatch $ snd . getCompose
-          requests0 :: Map (Some k) (Event t (IntMap (RequesterData request)))
-          requests0 = weakenDMapWith (fst . getCompose) children0
-          requests' :: Event t (p' (Some k) (Event t (IntMap (RequesterData request))))
-          requests' = fforCheap children' $ weakenPatchWith $ fst . getCompose
-          promptRequests :: Event t (Map (Some k) (IntMap (RequesterData request)))
-          promptRequests = coincidence $ fmapCheap (mergeMap . patchNewElements) requests' --TODO: Create a mergeIncrementalPromptly, and use that to eliminate this 'coincidence'
-      requests <- holdIncremental requests0 requests'
-  return (result0, result')
-
-data Decoder rawResponse response =
-  forall a. Decoder (RequesterDataKey a) (rawResponse -> response a)
-
--- | Matches incoming responses with previously-sent requests
--- and uses the provided request "decoder" function to process
--- incoming responses.
-matchResponsesWithRequests
-  :: forall t rawRequest rawResponse request response m.
-     ( MonadFix m
-     , MonadHold t m
-     , Reflex t
-     )
-  => (forall a. request a -> (rawRequest, rawResponse -> response a))
-  -- ^ Given a request (from 'Requester'), produces the wire format of the
-  -- request and a function used to process the associated response
-  -> Event t (RequesterData request)
-  -- ^ The outgoing requests
-  -> Event t (Int, rawResponse)
-  -- ^ The incoming responses, tagged by an identifying key
-  -> m ( Event t (Map Int rawRequest)
-       , Event t (RequesterData response)
-       )
-  -- ^ A map of outgoing wire-format requests and an event of responses keyed
-  -- by the 'RequesterData' key of the associated outgoing request
-matchResponsesWithRequests f send recv = do
-  rec nextId <- hold 1 $ fmap (\(next, _, _) -> next) outgoing
-      waitingFor :: Incremental t (PatchMap Int (Decoder rawResponse response)) <-
-        holdIncremental mempty $ leftmost
-          [ fmap (\(_, outstanding, _) -> outstanding) outgoing
-          , snd <$> incoming
-          ]
-      let outgoing = processOutgoing nextId send
-          incoming = processIncoming waitingFor recv
-  return (fmap (\(_, _, rawReqs) -> rawReqs) outgoing, fst <$> incoming)
-  where
-    -- Tags each outgoing request with an identifying integer key
-    -- and returns the next available key, a map of response decoders
-    -- for requests for which there are outstanding responses, and the
-    -- raw requests to be sent out.
-    processOutgoing
-      :: Behavior t Int
-      -- The next available key
-      -> Event t (RequesterData request)
-      -- The outgoing request
-      -> Event t ( Int
-                 , PatchMap Int (Decoder rawResponse response)
-                 , Map Int rawRequest )
-      -- The new next-available-key, a map of requests expecting responses, and the tagged raw requests
-    processOutgoing nextId out = flip pushAlways out $ \dm -> do
-      oldNextId <- sample nextId
-      let (result, newNextId) = flip runState oldNextId $ forM (requesterDataToList dm) $ \(k :=> v) -> do
-            n <- get
-            put $ succ n
-            let (rawReq, rspF) = f v
-            return (n, rawReq, Decoder k rspF)
-          patchWaitingFor = PatchMap $ Map.fromList $
-            (\(n, _, dec) -> (n, Just dec)) <$> result
-          toSend = Map.fromList $ (\(n, rawReq, _) -> (n, rawReq)) <$> result
-      return (newNextId, patchWaitingFor, toSend)
-    -- Looks up the each incoming raw response in a map of response
-    -- decoders and returns the decoded response and a patch that can
-    -- be used to clear the ID of the consumed response out of the queue
-    -- of expected responses.
-    processIncoming
-      :: Incremental t (PatchMap Int (Decoder rawResponse response))
-      -- A map of outstanding expected responses
-      -> Event t (Int, rawResponse)
-      -- A incoming response paired with its identifying key
-      -> Event t (RequesterData response, PatchMap Int v)
-      -- The decoded response and a patch that clears the outstanding responses queue
-    processIncoming waitingFor inc = flip push inc $ \(n, rawRsp) -> do
-      wf <- sample $ currentIncremental waitingFor
-      case Map.lookup n wf of
-        Nothing -> return Nothing -- TODO How should lookup failures be handled here? They shouldn't ever happen..
-        Just (Decoder k rspF) -> do
-          let rsp = rspF rawRsp
-          return $ Just
-            ( singletonRequesterData k rsp
-            , PatchMap $ Map.singleton n Nothing
-            )
--}

From ddf6544398fb0c25b10f317f9b0003821e42c7ac Mon Sep 17 00:00:00 2001
From: Joe Betz <joebetz91@gmail.com>
Date: Tue, 7 Jan 2020 18:30:30 +0200
Subject: [PATCH 15/34] restore forRequesterData

---
 src/Reflex/Requester/Base.hs          | 2 +-
 src/Reflex/Requester/Base/Internal.hs | 4 ++++
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/src/Reflex/Requester/Base.hs b/src/Reflex/Requester/Base.hs
index bf71fab5..ca60410d 100644
--- a/src/Reflex/Requester/Base.hs
+++ b/src/Reflex/Requester/Base.hs
@@ -10,7 +10,7 @@ module Reflex.Requester.Base
 --  , RequesterData
 --  , RequesterDataKey
   , traverseRequesterData
---  , forRequesterData
+  , forRequesterData
 --  , requesterDataToList
 --  , singletonRequesterData
 --  , matchResponsesWithRequests
diff --git a/src/Reflex/Requester/Base/Internal.hs b/src/Reflex/Requester/Base/Internal.hs
index d0fa81d7..337ac2e8 100644
--- a/src/Reflex/Requester/Base/Internal.hs
+++ b/src/Reflex/Requester/Base/Internal.hs
@@ -64,6 +64,10 @@ traverseRequesterData f (RequestData tg es) = ResponseData tg . TagMap.fromList
           Just t -> Just . (t :=>) <$> f req
           Nothing -> Nothing <$ f req
 
+-- | 'traverseRequesterData' with its arguments flipped
+forRequesterData :: forall request response m. Applicative m => RequestData (PrimState m) request -> (forall a. request a -> m (response a)) -> m (ResponseData (PrimState m) response)
+forRequesterData r f = traverseRequesterData f r
+
 runRequesterT :: forall t request response m a
   .  ( Reflex t
      , PrimMonad m

From a9ceb8cf53269a991f906f54b0e53b563b324c06 Mon Sep 17 00:00:00 2001
From: Joe Betz <joebetz91@gmail.com>
Date: Wed, 8 Jan 2020 14:19:41 +0200
Subject: [PATCH 16/34] reenable RequesterT tests

---
 test/RequesterT.hs | 46 +++++++++++++++++++++++-----------------------
 1 file changed, 23 insertions(+), 23 deletions(-)

diff --git a/test/RequesterT.hs b/test/RequesterT.hs
index 53bc12e2..981a4ef1 100644
--- a/test/RequesterT.hs
+++ b/test/RequesterT.hs
@@ -16,7 +16,7 @@ import Data.Dependent.Sum
 import Data.Functor.Misc
 import qualified Data.Map as M
 import Data.These
-import Data.Foldable
+import Data.List.NonEmpty.Deferred
 
 #if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
 import Data.These.Lens
@@ -32,31 +32,31 @@ data RequestInt a where
 
 main :: IO ()
 main = do
---  os1 <- runApp' (unwrapApp testOrdering) $
---    [ Just ()
---    ]
---  print os1
---  os2 <- runApp' (unwrapApp testSimultaneous) $ map Just $
---    [ This ()
---    , That ()
---    , This ()
---    , These () ()
---    ]
---  print os2
---  os3 <- runApp' (unwrapApp testMoribundRequest) [Just ()]
---  print os3
+  os1 <- runApp' (unwrapApp testOrdering) $
+    [ Just ()
+    ]
+  print os1
+  os2 <- runApp' (unwrapApp testSimultaneous) $ map Just $
+    [ This ()
+    , That ()
+    , This ()
+    , These () ()
+    ]
+  print os2
+  os3 <- runApp' (unwrapApp testMoribundRequest) [Just ()]
+  print os3
   os4 <- runApp' (unwrapApp testMoribundRequestDMap) [Just ()]
   print os4
---  os5 <- runApp' (unwrapApp testLiveRequestDMap) [Just ()]
---  print os5
---  os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
---  print os6
---  let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1
---  let ![[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]] = os2
---  let ![[Nothing, Just [2]]] = os3
+  os5 <- runApp' (unwrapApp testLiveRequestDMap) [Just ()]
+  print os5
+  os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
+  print os6
+  let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1
+  let ![[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],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 ![[Nothing, Just [1, 2]]] = os5
+  let ![[Nothing, Nothing]] = os6 -- TODO re-enable this test after issue #233 has been resolved
   return ()
 
 unwrapApp :: forall t m a.

From 90c60ddfe6439cf041a4bf4a3cd13a0a9e697c76 Mon Sep 17 00:00:00 2001
From: Joe Betz <joebetz91@gmail.com>
Date: Wed, 8 Jan 2020 20:56:48 +0200
Subject: [PATCH 17/34] add test case for broken Adjustable networks (#369)

---
 reflex.cabal       | 14 +++++++++++
 test/Adjustable.hs | 62 ++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 76 insertions(+)
 create mode 100644 test/Adjustable.hs

diff --git a/reflex.cabal b/reflex.cabal
index d736c3a9..c8fce57f 100644
--- a/reflex.cabal
+++ b/reflex.cabal
@@ -288,6 +288,20 @@ test-suite RequesterT
     Reflex.Plan.Pure
     Test.Run
 
+test-suite Adjustable
+  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
   type: exitcode-stdio-1.0
   main-is: QueryT.hs
diff --git a/test/Adjustable.hs b/test/Adjustable.hs
new file mode 100644
index 00000000..fb211eca
--- /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 ]
+  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]
+  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
\ No newline at end of file

From 09dad0584e586e388fed86710d0bdb51f5f194d7 Mon Sep 17 00:00:00 2001
From: Joe Betz <joebetz91@gmail.com>
Date: Wed, 8 Jan 2020 22:02:20 +0200
Subject: [PATCH 18/34] add bang pattern to expected test result

---
 test/Adjustable.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/test/Adjustable.hs b/test/Adjustable.hs
index fb211eca..150c3303 100644
--- a/test/Adjustable.hs
+++ b/test/Adjustable.hs
@@ -17,12 +17,12 @@ import Test.Run
 
 main :: IO ()
 main = do
-  let actions =  [ Increment, Update0th, Increment, Swap, Increment ]
+  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]
+  let !True = last (last os) == [expectedCount,expectedCount]
   return ()
 
 data PatchMapTestAction
@@ -59,4 +59,4 @@ testPatchMapWithMove pulse = do
       (Map.fromList $ zip [0..] "ab")
       (fmapMaybe id pulseAction)
     return ()
-  return result
\ No newline at end of file
+  return result

From b87ab78df97eeb9e4289d44ec0da04710e7e1ea8 Mon Sep 17 00:00:00 2001
From: Joe Betz <joebetz91@gmail.com>
Date: Tue, 14 Jan 2020 19:37:23 +0100
Subject: [PATCH 19/34] WIP: resurrecting functions we still want

---
 src/Data/TagMap.hs                    |   4 +
 src/Data/Unique/Tag/Local/Internal.hs |   2 +
 src/Reflex/Requester/Base/Internal.hs | 169 +++++++++++++++++++++++++-
 3 files changed, 173 insertions(+), 2 deletions(-)

diff --git a/src/Data/TagMap.hs b/src/Data/TagMap.hs
index fef9bf37..b1944845 100644
--- a/src/Data/TagMap.hs
+++ b/src/Data/TagMap.hs
@@ -8,6 +8,7 @@ module Data.TagMap
   , fromList
   , insert
   , size
+  , singletonTagMap
   ) where
 
 import Data.IntMap (IntMap)
@@ -37,3 +38,6 @@ fromList = TagMap . IntMap.fromList . fmap (\(t :=> v) -> (tagId t, (unsafeCoerc
 
 size :: TagMap x v -> Int
 size = IntMap.size . unTagMap
+
+singletonTagMap :: forall ps k v a. Tag ps k -> v a -> TagMap k v
+singletonTagMap tag v = TagMap $ IntMap.singleton (tagId tag) $ (unsafeCoerce :: v a -> Any) v
diff --git a/src/Data/Unique/Tag/Local/Internal.hs b/src/Data/Unique/Tag/Local/Internal.hs
index 739e3883..07747dba 100644
--- a/src/Data/Unique/Tag/Local/Internal.hs
+++ b/src/Data/Unique/Tag/Local/Internal.hs
@@ -20,6 +20,8 @@ import GHC.Exts (Int (..), Int#, MutVar#, unsafeCoerce#)
 
 import Unsafe.Coerce
 
+-- `x` is which generator it's from
+-- `a` is the type of the thing it's tagging
 newtype Tag x a = Tag Int
 
 tagId :: Tag x a -> Int
diff --git a/src/Reflex/Requester/Base/Internal.hs b/src/Reflex/Requester/Base/Internal.hs
index 337ac2e8..511bb652 100644
--- a/src/Reflex/Requester/Base/Internal.hs
+++ b/src/Reflex/Requester/Base/Internal.hs
@@ -10,6 +10,7 @@
 {-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -31,10 +32,12 @@ import Reflex.EventWriter.Class
 
 import Control.Applicative (liftA2)
 import Control.Monad.Exception
+import Control.Monad.Fail
 import Control.Monad.Identity
 import Control.Monad.Primitive
 import Control.Monad.Reader
 import Control.Monad.Ref
+import Control.Monad.State
 import Data.Coerce
 import Data.Dependent.Map (DSum (..))
 import qualified Data.List.NonEmpty as NonEmpty
@@ -55,7 +58,15 @@ import Unsafe.Coerce
 
 import Debug.Trace
 
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified Data.IntMap as IntMap
+import GHC.Exts (Any)
+
 data RequestData ps request = forall s. RequestData !(TagGen ps s) !(NonEmptyDeferred (RequestEnvelope s request))
+
+data RequestEnvelope s request = forall a. RequestEnvelope {-# UNPACK #-} !(Maybe (Tag s a)) !(request a)
+
 data ResponseData ps response = forall s. ResponseData !(TagGen ps s) !(TagMap s response)
 
 traverseRequesterData :: forall m request response. Applicative m => (forall a. request a -> m (response a)) -> RequestData (PrimState m) request -> m (ResponseData (PrimState m) response)
@@ -110,8 +121,6 @@ withRequesterInternalT f = do
       ((responses, result), requests) <- runEventWriterT $ runReaderT a (fanTag responses, tg)
   pure result
 
-data RequestEnvelope s request = forall a. RequestEnvelope {-# UNPACK #-} !(Maybe (Tag s a)) !(request a)
-
 -- This is because using forall ruins inlining
 data FakeRequesterStatePhantom
 
@@ -210,3 +219,159 @@ instance (Adjustable t m, MonadHold t m) => Adjustable t (RequesterT t request r
   traverseDMapWithKeyWithAdjust f dm0 dm' = RequesterT $ traverseDMapWithKeyWithAdjust (\k v -> unRequesterT $ f k v) dm0 dm'
   {-# INLINE traverseDMapWithKeyWithAdjustWithMove #-}
   traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = RequesterT $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unRequesterT $ f k v) dm0 dm'
+
+
+data Decoder rawResponse response ps =
+  forall a. Decoder (TagGen ps a) (rawResponse -> response a)
+
+-- | Matches incoming responses with previously-sent requests
+-- and uses the provided request "decoder" function to process
+-- incoming responses.
+matchResponsesWithRequests
+  :: forall t rawRequest rawResponse request response m.
+     ( MonadFix m
+     , MonadHold t m
+     , MonadFail m
+     , PrimMonad m
+     , Reflex t
+     )
+  => (forall a. request a -> (rawRequest, rawResponse -> response a))
+  -- ^ Given a request (from 'Requester'), produces the wire format of the
+  -- request and a function used to process the associated response
+  -> Event t (RequestData (PrimState m) request)
+  -- ^ The outgoing requests
+  -> Event t (Int, rawResponse)
+  -- ^ The incoming responses, tagged by an identifying key
+  -> m ( Event t (Map Int rawRequest)
+       , Event t (ResponseData (PrimState m) response)
+       )
+  -- ^ A map of outgoing wire-format requests and an event of responses keyed
+  -- by the 'RequesterData' key of the associated outgoing request
+matchResponsesWithRequests f send recv = mdo
+  waitingFor :: Incremental t (PatchMap Int (Decoder rawResponse response (PrimState m))) <- holdIncremental mempty $
+    leftmost [ fst <$> outgoing, snd <$> incoming ]
+  let outgoing = processOutgoing send
+      incoming = processIncoming waitingFor recv
+  return (snd <$> outgoing, fst <$> incoming)
+  where
+
+    -- Tags each outgoing request with an identifying integer key
+    -- and returns the next available key, a map of response decoders
+    -- for requests for which there are outstanding responses, and the
+    -- raw requests to be sent out.
+
+    {--
+
+    src/Reflex/Requester/Base/Internal.hs:271:53-67: error:
+    • Couldn't match type ‘a’ with ‘s’
+      ‘a’ is a rigid type variable bound by
+        a pattern with constructor:
+          :=> :: forall k (tag :: k -> *) (f :: k -> *) (a :: k).
+                 tag a -> f a -> DSum tag f,
+        in a lambda abstraction
+        at src/Reflex/Requester/Base/Internal.hs:269:98-104
+      ‘s’ is a rigid type variable bound by
+        a pattern with constructor:
+          RequestData :: forall ps (request :: * -> *) s.
+                         TagGen ps s
+                         -> NonEmptyDeferred (RequestEnvelope s request)
+                         -> RequestData ps request,
+        in a lambda abstraction
+        at src/Reflex/Requester/Base/Internal.hs:268:85-119
+      Expected type: rawResponse -> response s
+        Actual type: rawResponse -> response a
+    • In the second argument of ‘Decoder’, namely ‘responseDecoder’
+      In the expression: Decoder tagGen responseDecoder
+      In the expression:
+        (tagId k, rawRequest, Decoder tagGen responseDecoder)
+    • Relevant bindings include
+        responseDecoder :: rawResponse -> response a
+          (bound at src/Reflex/Requester/Base/Internal.hs:270:30)
+        v :: request a
+          (bound at src/Reflex/Requester/Base/Internal.hs:269:104)
+        k :: Tag s a
+          (bound at src/Reflex/Requester/Base/Internal.hs:269:98)
+        requestEnvelopes :: NonEmptyDeferred (RequestEnvelope s request)
+          (bound at src/Reflex/Requester/Base/Internal.hs:268:104)
+        tagGen :: TagGen (PrimState m) s
+          (bound at src/Reflex/Requester/Base/Internal.hs:268:97)
+    |
+271 |             in (tagId k, rawRequest, Decoder tagGen
+responseDecoder)
+    |
+^^^^^^^^^^^^^^^
+    --}
+    processOutgoing
+      :: Event t (RequestData (PrimState m) request)
+      -- The outgoing request
+      -> Event t ( PatchMap Int (Decoder rawResponse response (PrimState m))
+                 , Map Int rawRequest )
+      -- A map of requests expecting responses, and the tagged raw requests
+    processOutgoing eventOutgoingRequest = flip pushAlways eventOutgoingRequest $ \(RequestData tagGen requestEnvelopes) -> do
+      let results = ffor (requestEnvelopesToList $ NonEmptyDeferred.toList requestEnvelopes) $ \(k :=> v) ->
+            let (rawRequest, responseDecoder) = f v
+            in (tagId k, rawRequest, Decoder tagGen responseDecoder)
+      let patchWaitingFor = PatchMap $ Map.fromList $ (\(n, _, dec) -> (n, Just dec)) <$> results
+      let toSend = Map.fromList $ (\(n, rawRequest, _) -> (n, rawRequest)) <$> results
+      return (patchWaitingFor, toSend)
+
+    -- Looks up the each incoming raw response in a map of response
+    -- decoders and returns the decoded response and a patch that can
+    -- be used to clear the ID of the consumed response out of the queue
+    -- of expected responses.
+    processIncoming
+      :: Incremental t (PatchMap Int (Decoder rawResponse response (PrimState m)))
+      -- A map of outstanding expected responses
+      -> Event t (Int, rawResponse)
+      -- A incoming response paired with its identifying key
+      -> Event t (ResponseData (PrimState m) response, PatchMap Int v)
+      -- The decoded response and a patch that clears the outstanding responses queue
+    processIncoming incWaitingFor inc = flip push inc $ \(n, rawRsp) -> do
+      waitingFor <- sample $ currentIncremental incWaitingFor
+      case Map.lookup n waitingFor of
+        Nothing -> return Nothing -- TODO How should lookup failures be handled here? They shouldn't ever happen..
+        Just (Decoder tagGen responseDecoder) -> do
+          let rsp = responseDecoder rawRsp
+          return $ Just
+            ( singletonRequesterData @m tagGen (unsafeTagFromId n) rsp
+            , PatchMap $ Map.singleton n Nothing
+            )
+
+singletonRequesterData :: TagGen (PrimState m) a -> Tag (PrimState m) a -> response a -> ResponseData (PrimState m) response
+singletonRequesterData tagGen tag response =
+  ResponseData tagGen $ TagMap.singletonTagMap tag response
+
+{--
+  src/Reflex/Requester/Base/Internal.hs:304:40-78: error:
+      • Couldn't match type ‘s1’ with ‘s’
+        ‘s1’ is a rigid type variable bound by
+          a pattern with constructor:
+            RequestData :: forall ps (request :: * -> *) s.
+                          TagGen ps s
+                          -> NonEmptyDeferred (RequestEnvelope s request)
+                          -> RequestData ps request,
+          in an equation for ‘requesterDataToList’
+          at src/Reflex/Requester/Base/Internal.hs:303:22-50
+        ‘s’ is a rigid type variable bound by
+          the type signature for:
+            requesterDataToList :: forall (m :: * -> *) (request :: * ->
+  *) s.
+                                  RequestData (PrimState m) request ->
+  [DSum (Tag s) request]
+          at src/Reflex/Requester/Base/Internal.hs:302:1-102
+        Expected type: [RequestEnvelope s request]
+          Actual type: [RequestEnvelope s1 request]
+      • In the second argument of ‘($)’, namely
+          ‘NonEmptyDeferred.toList requestEnvelope’
+        In the expression:
+          requestEnvelopesToList @s @request
+            $ NonEmptyDeferred.toList requestEnvelope
+--}
+requesterDataToList :: forall m request s. RequestData (PrimState m) request -> [DSum (Tag s) request]
+requesterDataToList (RequestData _ requestEnvelope) =
+  requestEnvelopesToList @s @request $ NonEmptyDeferred.toList requestEnvelope
+
+requestEnvelopesToList :: forall s request. [RequestEnvelope s request] -> [DSum (Tag s) request]
+requestEnvelopesToList reqEnvs = f <$> reqEnvs
+  where f :: (RequestEnvelope s request)-> DSum (Tag s) request
+        f (RequestEnvelope (Just tag) v) = tag :=> v
\ No newline at end of file

From 5a5b431ab71122913210d6338003f8f0fc19b6d4 Mon Sep 17 00:00:00 2001
From: Joe Betz <joebetz91@gmail.com>
Date: Wed, 15 Jan 2020 21:57:12 +0100
Subject: [PATCH 20/34] fix decoder definition and mixed up existentials

---
 src/Reflex/Requester/Base/Internal.hs | 104 ++++----------------------
 1 file changed, 14 insertions(+), 90 deletions(-)

diff --git a/src/Reflex/Requester/Base/Internal.hs b/src/Reflex/Requester/Base/Internal.hs
index 511bb652..7bc2fee2 100644
--- a/src/Reflex/Requester/Base/Internal.hs
+++ b/src/Reflex/Requester/Base/Internal.hs
@@ -221,8 +221,8 @@ instance (Adjustable t m, MonadHold t m) => Adjustable t (RequesterT t request r
   traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = RequesterT $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unRequesterT $ f k v) dm0 dm'
 
 
-data Decoder rawResponse response ps =
-  forall a. Decoder (TagGen ps a) (rawResponse -> response a)
+data Decoder rawResponse response =
+  forall s a. Decoder (Tag s a) (rawResponse -> response a)
 
 -- | Matches incoming responses with previously-sent requests
 -- and uses the provided request "decoder" function to process
@@ -247,11 +247,11 @@ matchResponsesWithRequests
        )
   -- ^ A map of outgoing wire-format requests and an event of responses keyed
   -- by the 'RequesterData' key of the associated outgoing request
-matchResponsesWithRequests f send recv = mdo
-  waitingFor :: Incremental t (PatchMap Int (Decoder rawResponse response (PrimState m))) <- holdIncremental mempty $
+matchResponsesWithRequests f send recv = withTagGen $ \tagGen ->  mdo
+  waitingFor <- holdIncremental mempty $
     leftmost [ fst <$> outgoing, snd <$> incoming ]
   let outgoing = processOutgoing send
-      incoming = processIncoming waitingFor recv
+      incoming = processIncoming waitingFor tagGen recv
   return (snd <$> outgoing, fst <$> incoming)
   where
 
@@ -259,58 +259,16 @@ matchResponsesWithRequests f send recv = mdo
     -- and returns the next available key, a map of response decoders
     -- for requests for which there are outstanding responses, and the
     -- raw requests to be sent out.
-
-    {--
-
-    src/Reflex/Requester/Base/Internal.hs:271:53-67: error:
-    • Couldn't match type ‘a’ with ‘s’
-      ‘a’ is a rigid type variable bound by
-        a pattern with constructor:
-          :=> :: forall k (tag :: k -> *) (f :: k -> *) (a :: k).
-                 tag a -> f a -> DSum tag f,
-        in a lambda abstraction
-        at src/Reflex/Requester/Base/Internal.hs:269:98-104
-      ‘s’ is a rigid type variable bound by
-        a pattern with constructor:
-          RequestData :: forall ps (request :: * -> *) s.
-                         TagGen ps s
-                         -> NonEmptyDeferred (RequestEnvelope s request)
-                         -> RequestData ps request,
-        in a lambda abstraction
-        at src/Reflex/Requester/Base/Internal.hs:268:85-119
-      Expected type: rawResponse -> response s
-        Actual type: rawResponse -> response a
-    • In the second argument of ‘Decoder’, namely ‘responseDecoder’
-      In the expression: Decoder tagGen responseDecoder
-      In the expression:
-        (tagId k, rawRequest, Decoder tagGen responseDecoder)
-    • Relevant bindings include
-        responseDecoder :: rawResponse -> response a
-          (bound at src/Reflex/Requester/Base/Internal.hs:270:30)
-        v :: request a
-          (bound at src/Reflex/Requester/Base/Internal.hs:269:104)
-        k :: Tag s a
-          (bound at src/Reflex/Requester/Base/Internal.hs:269:98)
-        requestEnvelopes :: NonEmptyDeferred (RequestEnvelope s request)
-          (bound at src/Reflex/Requester/Base/Internal.hs:268:104)
-        tagGen :: TagGen (PrimState m) s
-          (bound at src/Reflex/Requester/Base/Internal.hs:268:97)
-    |
-271 |             in (tagId k, rawRequest, Decoder tagGen
-responseDecoder)
-    |
-^^^^^^^^^^^^^^^
-    --}
     processOutgoing
       :: Event t (RequestData (PrimState m) request)
       -- The outgoing request
-      -> Event t ( PatchMap Int (Decoder rawResponse response (PrimState m))
+      -> Event t ( PatchMap Int (Decoder rawResponse response)
                  , Map Int rawRequest )
       -- A map of requests expecting responses, and the tagged raw requests
     processOutgoing eventOutgoingRequest = flip pushAlways eventOutgoingRequest $ \(RequestData tagGen requestEnvelopes) -> do
       let results = ffor (requestEnvelopesToList $ NonEmptyDeferred.toList requestEnvelopes) $ \(k :=> v) ->
             let (rawRequest, responseDecoder) = f v
-            in (tagId k, rawRequest, Decoder tagGen responseDecoder)
+            in (tagId k, rawRequest, Decoder k responseDecoder)
       let patchWaitingFor = PatchMap $ Map.fromList $ (\(n, _, dec) -> (n, Just dec)) <$> results
       let toSend = Map.fromList $ (\(n, rawRequest, _) -> (n, rawRequest)) <$> results
       return (patchWaitingFor, toSend)
@@ -320,58 +278,24 @@ responseDecoder)
     -- be used to clear the ID of the consumed response out of the queue
     -- of expected responses.
     processIncoming
-      :: Incremental t (PatchMap Int (Decoder rawResponse response (PrimState m)))
+      :: Incremental t (PatchMap Int (Decoder rawResponse response))
+      -> TagGen (PrimState m) s
       -- A map of outstanding expected responses
       -> Event t (Int, rawResponse)
       -- A incoming response paired with its identifying key
       -> Event t (ResponseData (PrimState m) response, PatchMap Int v)
       -- The decoded response and a patch that clears the outstanding responses queue
-    processIncoming incWaitingFor inc = flip push inc $ \(n, rawRsp) -> do
+    processIncoming incWaitingFor tagGen inc = flip push inc $ \(n, rawRsp) -> do
       waitingFor <- sample $ currentIncremental incWaitingFor
       case Map.lookup n waitingFor of
         Nothing -> return Nothing -- TODO How should lookup failures be handled here? They shouldn't ever happen..
-        Just (Decoder tagGen responseDecoder) -> do
-          let rsp = responseDecoder rawRsp
+        Just (Decoder tag responseDecoder) ->
           return $ Just
-            ( singletonRequesterData @m tagGen (unsafeTagFromId n) rsp
+            ( ResponseData tagGen $ TagMap.singletonTagMap (unsafeTagFromId n) (responseDecoder rawRsp)
             , PatchMap $ Map.singleton n Nothing
             )
 
-singletonRequesterData :: TagGen (PrimState m) a -> Tag (PrimState m) a -> response a -> ResponseData (PrimState m) response
-singletonRequesterData tagGen tag response =
-  ResponseData tagGen $ TagMap.singletonTagMap tag response
-
-{--
-  src/Reflex/Requester/Base/Internal.hs:304:40-78: error:
-      • Couldn't match type ‘s1’ with ‘s’
-        ‘s1’ is a rigid type variable bound by
-          a pattern with constructor:
-            RequestData :: forall ps (request :: * -> *) s.
-                          TagGen ps s
-                          -> NonEmptyDeferred (RequestEnvelope s request)
-                          -> RequestData ps request,
-          in an equation for ‘requesterDataToList’
-          at src/Reflex/Requester/Base/Internal.hs:303:22-50
-        ‘s’ is a rigid type variable bound by
-          the type signature for:
-            requesterDataToList :: forall (m :: * -> *) (request :: * ->
-  *) s.
-                                  RequestData (PrimState m) request ->
-  [DSum (Tag s) request]
-          at src/Reflex/Requester/Base/Internal.hs:302:1-102
-        Expected type: [RequestEnvelope s request]
-          Actual type: [RequestEnvelope s1 request]
-      • In the second argument of ‘($)’, namely
-          ‘NonEmptyDeferred.toList requestEnvelope’
-        In the expression:
-          requestEnvelopesToList @s @request
-            $ NonEmptyDeferred.toList requestEnvelope
---}
-requesterDataToList :: forall m request s. RequestData (PrimState m) request -> [DSum (Tag s) request]
-requesterDataToList (RequestData _ requestEnvelope) =
-  requestEnvelopesToList @s @request $ NonEmptyDeferred.toList requestEnvelope
-
 requestEnvelopesToList :: forall s request. [RequestEnvelope s request] -> [DSum (Tag s) request]
 requestEnvelopesToList reqEnvs = f <$> reqEnvs
-  where f :: (RequestEnvelope s request)-> DSum (Tag s) request
-        f (RequestEnvelope (Just tag) v) = tag :=> v
\ No newline at end of file
+  where f :: (RequestEnvelope s request) -> DSum (Tag s) request
+        f (RequestEnvelope (Just tag) v) = tag :=> v

From 0c05acea81ab352d3de13752ff966b38a2f1e524 Mon Sep 17 00:00:00 2001
From: Joe Betz <joebetz91@gmail.com>
Date: Thu, 16 Jan 2020 17:50:03 +0100
Subject: [PATCH 21/34] restore some helper functions

---
 src/Reflex/Requester/Base.hs          |  7 ++++---
 src/Reflex/Requester/Base/Internal.hs | 27 ++++++++++++++++++---------
 2 files changed, 22 insertions(+), 12 deletions(-)

diff --git a/src/Reflex/Requester/Base.hs b/src/Reflex/Requester/Base.hs
index ca60410d..30d5e195 100644
--- a/src/Reflex/Requester/Base.hs
+++ b/src/Reflex/Requester/Base.hs
@@ -11,9 +11,10 @@ module Reflex.Requester.Base
 --  , RequesterDataKey
   , traverseRequesterData
   , forRequesterData
---  , requesterDataToList
---  , singletonRequesterData
---  , matchResponsesWithRequests
+  , requestEnvelopesToList
+  , singletonRequestData
+  , singletonResponseData
+  , matchResponsesWithRequests
 --  , multiEntry
 --  , unMultiEntry
 --  , requesting'
diff --git a/src/Reflex/Requester/Base/Internal.hs b/src/Reflex/Requester/Base/Internal.hs
index 7bc2fee2..207fd760 100644
--- a/src/Reflex/Requester/Base/Internal.hs
+++ b/src/Reflex/Requester/Base/Internal.hs
@@ -231,7 +231,6 @@ matchResponsesWithRequests
   :: forall t rawRequest rawResponse request response m.
      ( MonadFix m
      , MonadHold t m
-     , MonadFail m
      , PrimMonad m
      , Reflex t
      )
@@ -265,8 +264,8 @@ matchResponsesWithRequests f send recv = withTagGen $ \tagGen ->  mdo
       -> Event t ( PatchMap Int (Decoder rawResponse response)
                  , Map Int rawRequest )
       -- A map of requests expecting responses, and the tagged raw requests
-    processOutgoing eventOutgoingRequest = flip pushAlways eventOutgoingRequest $ \(RequestData tagGen requestEnvelopes) -> do
-      let results = ffor (requestEnvelopesToList $ NonEmptyDeferred.toList requestEnvelopes) $ \(k :=> v) ->
+    processOutgoing eventOutgoingRequest = flip pushAlways eventOutgoingRequest $ \(RequestData _ requestEnvelopes) -> do
+      let results = ffor (requestEnvelopesToList requestEnvelopes) $ \(k :=> v) ->
             let (rawRequest, responseDecoder) = f v
             in (tagId k, rawRequest, Decoder k responseDecoder)
       let patchWaitingFor = PatchMap $ Map.fromList $ (\(n, _, dec) -> (n, Just dec)) <$> results
@@ -279,8 +278,9 @@ matchResponsesWithRequests f send recv = withTagGen $ \tagGen ->  mdo
     -- of expected responses.
     processIncoming
       :: Incremental t (PatchMap Int (Decoder rawResponse response))
-      -> TagGen (PrimState m) s
       -- A map of outstanding expected responses
+      -> TagGen (PrimState m) s
+      -- A tag generator
       -> Event t (Int, rawResponse)
       -- A incoming response paired with its identifying key
       -> Event t (ResponseData (PrimState m) response, PatchMap Int v)
@@ -291,11 +291,20 @@ matchResponsesWithRequests f send recv = withTagGen $ \tagGen ->  mdo
         Nothing -> return Nothing -- TODO How should lookup failures be handled here? They shouldn't ever happen..
         Just (Decoder tag responseDecoder) ->
           return $ Just
-            ( ResponseData tagGen $ TagMap.singletonTagMap (unsafeTagFromId n) (responseDecoder rawRsp)
+            ( singletonResponseData tagGen (unsafeTagFromId n) (responseDecoder rawRsp)
             , PatchMap $ Map.singleton n Nothing
             )
 
-requestEnvelopesToList :: forall s request. [RequestEnvelope s request] -> [DSum (Tag s) request]
-requestEnvelopesToList reqEnvs = f <$> reqEnvs
-  where f :: (RequestEnvelope s request) -> DSum (Tag s) request
-        f (RequestEnvelope (Just tag) v) = tag :=> v
+requestEnvelopesToList :: forall s request. NonEmptyDeferred (RequestEnvelope s request) -> [DSum (Tag s) request]
+requestEnvelopesToList requestEnvelopes = catMaybes $ f <$> NonEmptyDeferred.toList requestEnvelopes
+  where f :: (RequestEnvelope s request) -> Maybe (DSum (Tag s) request)
+        f (RequestEnvelope (Just tag) v) = Just (tag :=> v)
+        f (RequestEnvelope Nothing _) = Nothing
+
+singletonRequestData :: TagGen ps s -> Maybe (Tag s a) -> request a -> RequestData ps request
+singletonRequestData tagGen maybeTag request =
+  RequestData tagGen $ NonEmptyDeferred.singleton $ RequestEnvelope maybeTag request
+
+singletonResponseData :: TagGen ps s -> Tag ps s -> response a -> ResponseData ps response
+singletonResponseData tagGen tag response =
+  ResponseData tagGen $ TagMap.singletonTagMap tag response
\ No newline at end of file

From d1539afdfb1126b4de2b4f5c632d8ceffc16a401 Mon Sep 17 00:00:00 2001
From: Joe Betz <joebetz91@gmail.com>
Date: Thu, 16 Jan 2020 17:52:46 +0100
Subject: [PATCH 22/34] rename requestEnvelopesToList to
 requestEnvelopesToDSums

---
 src/Reflex/Requester/Base.hs          | 2 +-
 src/Reflex/Requester/Base/Internal.hs | 6 +++---
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Reflex/Requester/Base.hs b/src/Reflex/Requester/Base.hs
index 30d5e195..02d31779 100644
--- a/src/Reflex/Requester/Base.hs
+++ b/src/Reflex/Requester/Base.hs
@@ -11,7 +11,7 @@ module Reflex.Requester.Base
 --  , RequesterDataKey
   , traverseRequesterData
   , forRequesterData
-  , requestEnvelopesToList
+  , requestEnvelopesToDSums
   , singletonRequestData
   , singletonResponseData
   , matchResponsesWithRequests
diff --git a/src/Reflex/Requester/Base/Internal.hs b/src/Reflex/Requester/Base/Internal.hs
index 207fd760..8ae29e51 100644
--- a/src/Reflex/Requester/Base/Internal.hs
+++ b/src/Reflex/Requester/Base/Internal.hs
@@ -265,7 +265,7 @@ matchResponsesWithRequests f send recv = withTagGen $ \tagGen ->  mdo
                  , Map Int rawRequest )
       -- A map of requests expecting responses, and the tagged raw requests
     processOutgoing eventOutgoingRequest = flip pushAlways eventOutgoingRequest $ \(RequestData _ requestEnvelopes) -> do
-      let results = ffor (requestEnvelopesToList requestEnvelopes) $ \(k :=> v) ->
+      let results = ffor (requestEnvelopesToDSums requestEnvelopes) $ \(k :=> v) ->
             let (rawRequest, responseDecoder) = f v
             in (tagId k, rawRequest, Decoder k responseDecoder)
       let patchWaitingFor = PatchMap $ Map.fromList $ (\(n, _, dec) -> (n, Just dec)) <$> results
@@ -295,8 +295,8 @@ matchResponsesWithRequests f send recv = withTagGen $ \tagGen ->  mdo
             , PatchMap $ Map.singleton n Nothing
             )
 
-requestEnvelopesToList :: forall s request. NonEmptyDeferred (RequestEnvelope s request) -> [DSum (Tag s) request]
-requestEnvelopesToList requestEnvelopes = catMaybes $ f <$> NonEmptyDeferred.toList requestEnvelopes
+requestEnvelopesToDSums :: forall s request. NonEmptyDeferred (RequestEnvelope s request) -> [DSum (Tag s) request]
+requestEnvelopesToDSums requestEnvelopes = catMaybes $ f <$> NonEmptyDeferred.toList requestEnvelopes
   where f :: (RequestEnvelope s request) -> Maybe (DSum (Tag s) request)
         f (RequestEnvelope (Just tag) v) = Just (tag :=> v)
         f (RequestEnvelope Nothing _) = Nothing

From d9f7dec6e53b96ddc8d25ee505c8c8616e87ee87 Mon Sep 17 00:00:00 2001
From: Joe Betz <joebetz91@gmail.com>
Date: Thu, 16 Jan 2020 18:34:36 +0100
Subject: [PATCH 23/34] add tests for matchResponsesWithRequests

---
 test/RequesterT.hs | 67 ++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 65 insertions(+), 2 deletions(-)

diff --git a/test/RequesterT.hs b/test/RequesterT.hs
index 981a4ef1..508a9a67 100644
--- a/test/RequesterT.hs
+++ b/test/RequesterT.hs
@@ -1,22 +1,35 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
 {-# 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.Fail (MonadFail)
 import Control.Monad.Fix
+import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Monad.Primitive
+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.Map (Map)
 import qualified Data.Map as M
 import Data.These
 import Data.List.NonEmpty.Deferred
+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
@@ -27,6 +40,8 @@ import Reflex.Requester.Base
 import Reflex.Requester.Class
 import Test.Run
 
+import Debug.Trace hiding (traceEvent)
+
 data RequestInt a where
   RequestInt :: Int -> RequestInt Int
 
@@ -35,7 +50,7 @@ main = do
   os1 <- runApp' (unwrapApp testOrdering) $
     [ Just ()
     ]
-  print os1
+  --print os1
   os2 <- runApp' (unwrapApp testSimultaneous) $ map Just $
     [ This ()
     , That ()
@@ -51,12 +66,18 @@ main = do
   print os5
   os6 <- runApp' (unwrapApp delayedPulse) [Just ()]
   print os6
+  os7 <- runApp' testMatchRequestsWithResponses $ map Just [ TestRequest_Increment 1, TestRequest_Increment 2 ]
+  print os7
+  os8 <- runApp' testMatchRequestsWithResponses [ Just $ TestRequest_Reverse "abcd" ]
+  print os8
   let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1
   let ![[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],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 [(-9223372036854775808,"2")]) = M.toList <$> head (head os7)
+  let !(Just [(-9223372036854775808,"dcba")]) = M.toList <$> head (head os8)
   return ()
 
 unwrapApp :: forall t m a.
@@ -177,3 +198,45 @@ delayedPulse pulse = void $ flip runWithReplace (pure () <$ pulse) $ do
     -- 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
+     , PrimMonad m
+     , Show (req a)
+     , Show a
+     , MonadIO m
+     )
+  => Event t (req a) -> m (Event t (Map Int String))
+testMatchRequestsWithResponses pulse = mdo
+  (_, requests) <- runRequesterT (requesting pulse) responses
+  let rawResponseMap = 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 <$> rawResponseMap)
+  pure rawResponseMap
+  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
\ No newline at end of file

From bcf920c32f972fb2fa41a26c3ae0036cec442185 Mon Sep 17 00:00:00 2001
From: Joe Betz <joebetz91@gmail.com>
Date: Thu, 16 Jan 2020 18:49:31 +0100
Subject: [PATCH 24/34] test case for performEvent

---
 test/RequesterT.hs | 34 ++++++++++++++++++++++++++++------
 1 file changed, 28 insertions(+), 6 deletions(-)

diff --git a/test/RequesterT.hs b/test/RequesterT.hs
index 508a9a67..99600a30 100644
--- a/test/RequesterT.hs
+++ b/test/RequesterT.hs
@@ -17,7 +17,7 @@ import Control.Lens hiding (has)
 import Control.Monad
 import Control.Monad.Fail (MonadFail)
 import Control.Monad.Fix
-import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.IO.Class (MonadIO)
 import Control.Monad.Primitive
 import Data.Constraint.Extras
 import Data.Constraint.Extras.TH
@@ -70,6 +70,8 @@ main = do
   print os7
   os8 <- runApp' testMatchRequestsWithResponses [ Just $ TestRequest_Reverse "abcd" ]
   print os8
+  os9 <- runApp' testMoribundPerformEvent $ map Just [ 1 .. 3 ]
+  print os9
   let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1
   let ![[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]] = os2
   let ![[Nothing, Just [2]]] = os3
@@ -78,6 +80,7 @@ main = do
   let ![[Nothing, Nothing]] = os6 -- TODO re-enable this test after issue #233 has been resolved
   let !(Just [(-9223372036854775808,"2")]) = M.toList <$> head (head os7)
   let !(Just [(-9223372036854775808,"dcba")]) = M.toList <$> head (head os8)
+  let ![[Nothing,Just "0:1"],[Nothing,Just "1:2"],[Nothing,Just "2:3"]] = os9
   return ()
 
 unwrapApp :: forall t m a.
@@ -203,6 +206,11 @@ data TestRequest a where
   TestRequest_Reverse :: String -> TestRequest String
   TestRequest_Increment :: Int -> TestRequest Int
 
+instance Show (TestRequest a) where
+  show = \case
+    TestRequest_Reverse str -> "reverse " <> str
+    TestRequest_Increment i -> "increment " <> show i
+
 testMatchRequestsWithResponses
   :: forall m t req a
    . ( MonadFix m
@@ -234,9 +242,23 @@ testMatchRequestsWithResponses pulse = mdo
       , \x -> has @Read r $ readMaybe x
       )
 
-deriveArgDict ''TestRequest
+-- If a widget is destroyed, and simultaneously it tries to use performEvent, the event does not get performed.
+-- TODO Determine whether this is actually the behavior we want.
+testMoribundPerformEvent
+  :: forall t m
+   . ( Adjustable t m
+     , PerformEvent t m
+     , MonadHold t m
+     , Reflex t
+     )
+  => Event t Int -> m (Event t String)
+testMoribundPerformEvent pulse = do
+  (outputInitial, outputReplaced) <- runWithReplace (performPrint 0 pulse) $ ffor pulse $ \i -> performPrint i pulse
+  switchHold outputInitial outputReplaced
+  where
+    performPrint i evt =
+      performEvent $ ffor evt $ \output ->
+        return $ show i <> ":" <> show output
 
-instance Show (TestRequest a) where
-  show = \case
-    TestRequest_Reverse str -> "reverse " <> str
-    TestRequest_Increment i -> "increment " <> show i
\ No newline at end of file
+
+deriveArgDict ''TestRequest

From 29def8300206e0ef0f58b9d5092f3666e5347b95 Mon Sep 17 00:00:00 2001
From: Joe Betz <joebetz91@gmail.com>
Date: Fri, 17 Jan 2020 12:18:20 +0100
Subject: [PATCH 25/34] remove duplicate module

---
 reflex.cabal | 1 -
 1 file changed, 1 deletion(-)

diff --git a/reflex.cabal b/reflex.cabal
index 60c808a1..1cf57d8f 100644
--- a/reflex.cabal
+++ b/reflex.cabal
@@ -91,7 +91,6 @@ library
     Data.AppendMap,
     Data.FastMutableIntMap,
     Data.FastWeakBag,
-    Data.Functor.Misc,
     Data.List.Deferred,
     Data.List.NonEmpty.Deferred,
     Data.List.NonEmpty.Deferred.Internal,

From 9748ca37fe472c801b76c9b6125b632720caedbc Mon Sep 17 00:00:00 2001
From: Joe Betz <joebetz91@gmail.com>
Date: Fri, 17 Jan 2020 22:57:46 +0100
Subject: [PATCH 26/34] update changelog for requester refactor

---
 ChangeLog.md | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

diff --git a/ChangeLog.md b/ChangeLog.md
index e9fe837a..401e60d6 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -11,6 +11,25 @@
 
 * Additional instances for `Query` classes for basic types.
 
+* Refactor of `Reflex.Requester`:
+    * Updated:
+        * `RequesterData` to `RequestData`, `RequesterEnvelope`, and `ResponseData`
+        * `singletonRequesterData` to `singletonRequestData` and `singletonResponseData`
+        * `requesterDataToList` to `requestEnvelopesToDSums`
+    * Removed:
+        * `RequesterDataKey`
+        * `multiEntry`
+        * `unMultiEntry`
+        * `withRequesterT`
+        * `runWithReplaceRequesterTWith`
+        * `requesting'`
+        * `traverseIntMapWithKeyWithAdjustRequesterTWith`
+        * `traverseDMapWithKeyWithAdjustRequesterTWith`
+
+* Added `Data.List.Deferred` and `Data.List.NonEmpty.Deferred` for optimizing `<>` operations.
+
+* Added `Data.TagMap`, `Reflex.FanTag`, and `Data.Unique.Tag.Local` to improve request and response tagging.
+
 ## 0.6.3
 
 * `Data.WeakBag.traverse` and `Data.FastWeakBag.traverse` have been deprecated.

From 690aa6d84056700f8d62a55774cddacb8a116f1d Mon Sep 17 00:00:00 2001
From: John Ericson <John.Ericson@Obsidian.Systems>
Date: Tue, 21 Jan 2020 10:23:21 -0500
Subject: [PATCH 27/34] Delete IntMap.hs

It's from the patch library now
---
 src/Reflex/Patch/IntMap.hs | 70 --------------------------------------
 1 file changed, 70 deletions(-)
 delete mode 100644 src/Reflex/Patch/IntMap.hs

diff --git a/src/Reflex/Patch/IntMap.hs b/src/Reflex/Patch/IntMap.hs
deleted file mode 100644
index 0e3a45fc..00000000
--- a/src/Reflex/Patch/IntMap.hs
+++ /dev/null
@@ -1,70 +0,0 @@
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
--- | Module containing 'PatchIntMap', a 'Patch' for 'IntMap' which allows for
--- insert/update or delete of associations.
-module Reflex.Patch.IntMap where
-
-import Control.Lens
-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)
-
--- | @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
-
-makeWrapped ''PatchIntMap
-
--- | 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
-
--- | 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
-
-instance FunctorWithIndex Int PatchIntMap
-instance FoldableWithIndex Int PatchIntMap
-instance TraversableWithIndex Int PatchIntMap where
-  itraversed = _Wrapped . itraversed . traversed
-
--- | 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

From d73838ee9e7198ae9f66e02ff662d237ba0f90aa Mon Sep 17 00:00:00 2001
From: Owen Shepherd <owen.shepherd@obsidian.systems>
Date: Mon, 6 Apr 2020 16:57:28 +0100
Subject: [PATCH 28/34] add constraints(-extra) to RunRequesterT tests

---
 reflex.cabal | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/reflex.cabal b/reflex.cabal
index 26999bdf..ef7ec492 100644
--- a/reflex.cabal
+++ b/reflex.cabal
@@ -319,6 +319,8 @@ test-suite RequesterT
   hs-source-dirs: test
   build-depends: base
                , containers
+               , constraints
+               , constraints-extras
                , deepseq
                , dependent-map
                , dependent-sum

From b7eaf8983f2a73072ce0300acf1723235641cd67 Mon Sep 17 00:00:00 2001
From: Owen Shepherd <owen.shepherd@obsidian.systems>
Date: Mon, 6 Apr 2020 17:00:27 +0100
Subject: [PATCH 29/34] hlint fixes

---
 src/Data/List/NonEmpty/Deferred.hs    | 1 -
 src/Data/TagMap.hs                    | 2 +-
 src/Data/Unique/Tag/Local/Internal.hs | 5 +----
 src/Reflex/Requester/Base/Internal.hs | 5 ++---
 4 files changed, 4 insertions(+), 9 deletions(-)

diff --git a/src/Data/List/NonEmpty/Deferred.hs b/src/Data/List/NonEmpty/Deferred.hs
index 322eeee7..bfcd1713 100644
--- a/src/Data/List/NonEmpty/Deferred.hs
+++ b/src/Data/List/NonEmpty/Deferred.hs
@@ -2,7 +2,6 @@
 -- prevents external observers from observing the non-associativity.  This
 -- allows O(1) '(<>)'.
 
-{-# LANGUAGE LambdaCase #-}
 module Data.List.NonEmpty.Deferred
   ( NonEmptyDeferred
   , singleton
diff --git a/src/Data/TagMap.hs b/src/Data/TagMap.hs
index b1944845..b33b7942 100644
--- a/src/Data/TagMap.hs
+++ b/src/Data/TagMap.hs
@@ -28,7 +28,7 @@ fromDMap :: forall k x (v :: k -> *). DMap (Tag x) v -> TagMap x v
 fromDMap = TagMap . IntMap.fromDistinctAscList . fmap (\((k :: Tag x (a :: k)) :=> v) -> (tagId k, (unsafeCoerce :: v a -> Any) v)) . DMap.toAscList
 
 toDMap :: forall x v. TagMap x v -> DMap (Tag x) v
-toDMap = DMap.fromDistinctAscList . fmap (\(k, v) -> (unsafeTagFromId k :=> (unsafeCoerce :: Any -> v a) v)) . IntMap.toAscList . unTagMap
+toDMap = DMap.fromDistinctAscList . fmap (\(k, v) -> unsafeTagFromId k :=> (unsafeCoerce :: Any -> v a) v) . IntMap.toAscList . unTagMap
 
 insert :: forall x a v. Tag x a -> v a -> TagMap x v -> TagMap x v
 insert k v = TagMap . IntMap.insert (tagId k) ((unsafeCoerce :: v a -> Any) v) . unTagMap
diff --git a/src/Data/Unique/Tag/Local/Internal.hs b/src/Data/Unique/Tag/Local/Internal.hs
index 07747dba..7f55d567 100644
--- a/src/Data/Unique/Tag/Local/Internal.hs
+++ b/src/Data/Unique/Tag/Local/Internal.hs
@@ -2,9 +2,6 @@
 -- 1. If the `s` parameters on two `TagGen`s can unify, then they contain the same MutVar
 -- 2. Two Tag values made from the same TagGen never contain the same Int
 
-{-# LANGUAGE EmptyDataDecls #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RankNTypes #-}
@@ -31,7 +28,7 @@ tagId (Tag n) = n
 -- incorrect unsafeCoerce applications, which can segfault or cause arbitrary
 -- other damage to your program
 unsafeTagFromId :: Int -> Tag x a
-unsafeTagFromId n = Tag n
+unsafeTagFromId = Tag
 
 -- We use Int because it is supported by e.g. IntMap
 newtype TagGen ps s = TagGen { unTagGen :: MutVar ps Int }
diff --git a/src/Reflex/Requester/Base/Internal.hs b/src/Reflex/Requester/Base/Internal.hs
index 8ae29e51..1886b3c2 100644
--- a/src/Reflex/Requester/Base/Internal.hs
+++ b/src/Reflex/Requester/Base/Internal.hs
@@ -10,7 +10,6 @@
 {-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -297,7 +296,7 @@ matchResponsesWithRequests f send recv = withTagGen $ \tagGen ->  mdo
 
 requestEnvelopesToDSums :: forall s request. NonEmptyDeferred (RequestEnvelope s request) -> [DSum (Tag s) request]
 requestEnvelopesToDSums requestEnvelopes = catMaybes $ f <$> NonEmptyDeferred.toList requestEnvelopes
-  where f :: (RequestEnvelope s request) -> Maybe (DSum (Tag s) request)
+  where f :: RequestEnvelope s request -> Maybe (DSum (Tag s) request)
         f (RequestEnvelope (Just tag) v) = Just (tag :=> v)
         f (RequestEnvelope Nothing _) = Nothing
 
@@ -307,4 +306,4 @@ singletonRequestData tagGen maybeTag request =
 
 singletonResponseData :: TagGen ps s -> Tag ps s -> response a -> ResponseData ps response
 singletonResponseData tagGen tag response =
-  ResponseData tagGen $ TagMap.singletonTagMap tag response
\ No newline at end of file
+  ResponseData tagGen $ TagMap.singletonTagMap tag response

From d2d152d5f6fe57d4c00e9df75b180664b12904cc Mon Sep 17 00:00:00 2001
From: Owen Shepherd <owen.shepherd@obsidian.systems>
Date: Tue, 7 Apr 2020 16:45:38 +0100
Subject: [PATCH 30/34] remove defunct perform event TODOs

---
 src/Reflex/PerformEvent/Base.hs | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/src/Reflex/PerformEvent/Base.hs b/src/Reflex/PerformEvent/Base.hs
index aa1a9382..0d96f512 100644
--- a/src/Reflex/PerformEvent/Base.hs
+++ b/src/Reflex/PerformEvent/Base.hs
@@ -94,7 +94,6 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT
     (result0, requests0) <- lift $ runA a0
     newA <- requestingIdentity $ runA <$> a'
     requests <- switchHoldPromptOnly requests0 $ fmapCheap snd newA
-    --TODO: promptly *prevent* events, then sign up the new ones; this is a serious breaking change to PerformEvent
     RequesterInternalT $ tellEvent requests
     pure (result0, fmapCheap fst newA)
   {-# INLINE traverseIntMapWithKeyWithAdjust #-}
@@ -109,7 +108,6 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT
         results' = fmap fst <$> children'
         requests' = fmap snd `fmapCheap` children'
     requests <- switchHoldPromptOnlyIncremental mergeIntIncremental coincidencePatchIntMap requests0 requests'
-    --TODO: promptly *prevent* events, then sign up the new ones; this is a serious breaking change to PerformEvent
     RequesterInternalT $ tellEvent $ fforMaybeCheap requests concatIntMapMaybe
     pure (results0, results')
   {-# INLINE traverseDMapWithKeyWithAdjust #-}
@@ -125,7 +123,6 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT
         results' = mapPatchDMap (snd . getCompose) <$> children'
         requests' = weakenPatchDMapWith (fst . getCompose) `fmapCheap` children'
     requests <- switchHoldPromptOnlyIncremental mergeMapIncremental coincidencePatchMap requests0 requests'
-    --TODO: promptly *prevent* events, then sign up the new ones; this is a serious breaking change to PerformEvent
     RequesterInternalT $ tellEvent $ fforMaybeCheap requests concatMapMaybe
     pure (results0, results')
   {-# INLINE traverseDMapWithKeyWithAdjustWithMove #-}
@@ -141,7 +138,6 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => Adjustable t (PerformEventT
         results' = mapPatchDMapWithMove (snd . getCompose) <$> children'
         requests' = weakenPatchDMapWithMoveWith (fst . getCompose) `fmapCheap` children'
     requests <- switchHoldPromptOnlyIncremental mergeMapIncrementalWithMove coincidencePatchMapWithMove requests0 requests'
-    --TODO: promptly *prevent* events, then sign up the new ones; this is a serious breaking change to PerformEvent
     RequesterInternalT $ tellEvent $ fforMaybeCheap requests concatMapMaybe
     pure (results0, results')
 

From f1533890e9d26dbfd650baac3a2fa58eaad50823 Mon Sep 17 00:00:00 2001
From: Owen Shepherd <414owen@gmail.com>
Date: Wed, 8 Apr 2020 21:55:08 +0100
Subject: [PATCH 31/34] Remove obsolete TODO

---
 test/RequesterT.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/test/RequesterT.hs b/test/RequesterT.hs
index a532c5e8..30038127 100644
--- a/test/RequesterT.hs
+++ b/test/RequesterT.hs
@@ -255,7 +255,6 @@ testMatchRequestsWithResponses pulse = mdo
       )
 
 -- If a widget is destroyed, and simultaneously it tries to use performEvent, the event does not get performed.
--- TODO Determine whether this is actually the behavior we want.
 testMoribundPerformEvent
   :: forall t m
    . ( Adjustable t m

From 96ebc2beaa668bb47aaba048ffe19b57da0715e6 Mon Sep 17 00:00:00 2001
From: Owen Shepherd <414owen@gmail.com>
Date: Wed, 22 Apr 2020 13:28:56 +0000
Subject: [PATCH 32/34] Remove obsolete comment

---
 src/Reflex/Requester/Base/Internal.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Reflex/Requester/Base/Internal.hs b/src/Reflex/Requester/Base/Internal.hs
index 1886b3c2..722bfb45 100644
--- a/src/Reflex/Requester/Base/Internal.hs
+++ b/src/Reflex/Requester/Base/Internal.hs
@@ -90,7 +90,7 @@ runRequesterT (RequesterT a) wrappedResponses = withRequesterInternalT $ \reques
   (_, tg) <- RequesterInternalT ask
   result <- a
   let responses = fforMaybe wrappedResponses $ \(ResponseData tg' m) -> case tg `geq` tg' of
-        Nothing -> trace ("runRequesterT: bad TagGen: expected " <> show tg <> " but got " <> show tg') Nothing --TODO: Warn somehow
+        Nothing -> trace ("runRequesterT: bad TagGen: expected " <> show tg <> " but got " <> show tg') Nothing
         Just Refl -> Just m
   pure (responses, (result, fmapCheap (RequestData tg) requests))
 

From 8d498964c94bb31a0eeb55dd2e3cea1478d8a2d9 Mon Sep 17 00:00:00 2001
From: Owen Shepherd <owen.shepherd@obsidian.systems>
Date: Wed, 22 Apr 2020 14:35:00 +0100
Subject: [PATCH 33/34] added trace to processIncoming

---
 src/Reflex/Requester/Base/Internal.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Reflex/Requester/Base/Internal.hs b/src/Reflex/Requester/Base/Internal.hs
index 722bfb45..0efb8553 100644
--- a/src/Reflex/Requester/Base/Internal.hs
+++ b/src/Reflex/Requester/Base/Internal.hs
@@ -287,7 +287,7 @@ matchResponsesWithRequests f send recv = withTagGen $ \tagGen ->  mdo
     processIncoming incWaitingFor tagGen inc = flip push inc $ \(n, rawRsp) -> do
       waitingFor <- sample $ currentIncremental incWaitingFor
       case Map.lookup n waitingFor of
-        Nothing -> return Nothing -- TODO How should lookup failures be handled here? They shouldn't ever happen..
+        Nothing -> return $ trace ("processIncoming: lookup failure for response key '" <> show n <> "'") Nothing
         Just (Decoder tag responseDecoder) ->
           return $ Just
             ( singletonResponseData tagGen (unsafeTagFromId n) (responseDecoder rawRsp)

From 18a795e5b1649b099af2128bf552057fed048df0 Mon Sep 17 00:00:00 2001
From: Owen Shepherd <414owen@gmail.com>
Date: Fri, 24 Apr 2020 13:13:26 +0000
Subject: [PATCH 34/34] Added TellId removal to changelog

---
 ChangeLog.md | 1 +
 1 file changed, 1 insertion(+)

diff --git a/ChangeLog.md b/ChangeLog.md
index ebba605f..1c522809 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -45,6 +45,7 @@
         * `requesting'`
         * `traverseIntMapWithKeyWithAdjustRequesterTWith`
         * `traverseDMapWithKeyWithAdjustRequesterTWith`
+        * `TellId`
 
 * Added `Data.List.Deferred` and `Data.List.NonEmpty.Deferred` for optimizing `<>` operations.