@@ -38,7 +38,7 @@ import qualified Data.Dependent.Map as DMap
3838import Data.Foldable
3939import Data.Functor.Compose
4040import Data.Functor.Misc
41−import qualified Data.List.NonEmpty as NonEmpty
41+import Data.List.NonEmpty (NonEmpty (..))
4242import Data.Map (Map)
4343import Data.Semigroup
4444import Data.Sequence
@@ -47,7 +47,7 @@ import Data.Tuple
4747
4848-- | 'EventWriter' efficiently collects 'Event' values using 'tellEvent'
4949-- and combines them monoidally to provide an 'Event' result.
50−class (Monad m, Monoid w) => EventWriter t w m | m -> t w where
50+class (Monad m, Semigroup w) => EventWriter t w m | m -> t w where
5151 tellEvent :: Event t w -> m ()
5252
5353-- | A basic implementation of 'EventWriter'.
@@ -60,7 +60,7 @@ runEventWriterT (EventWriterT a) = do
6060 (result, requests) <- runStateT a mempty
6161 return (result, mconcat $ toList requests)
6262
63−instance (Reflex t, Monad m, Monoid w) => EventWriter t w (EventWriterT t w m) where
63+instance (Reflex t, Monad m, Semigroup w) => EventWriter t w (EventWriterT t w m) where
6464 tellEvent w = EventWriterT $ modify (|> w)
6565
6666instance EventWriter t w m => EventWriter t w (ReaderT r m) where
@@ -77,7 +77,7 @@ instance MonadHold t m => MonadHold t (EventWriterT t w m) where
7777 holdDyn v0 = lift . holdDyn v0
7878 holdIncremental v0 = lift . holdIncremental v0
7979
80−instance (Reflex t, MonadAdjust t m, MonadHold t m, Monoid w, Semigroup w) => MonadAdjust t (EventWriterT t w m) where
80+instance (Reflex t, MonadAdjust t m, MonadHold t m, Semigroup w, Semigroup w) => MonadAdjust t (EventWriterT t w m) where
8181 runWithReplace = runWithReplaceEventWriterTWith $ \dm0 dm' -> lift $ runWithReplace dm0 dm'
8282 traverseDMapWithKeyWithAdjust = sequenceDMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjust f dm0 dm') mapPatchDMap weakenPatchDMapWith patchMapNewElements mergeMapIncremental
8383 traverseDMapWithKeyWithAdjustWithMove = sequenceDMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjustWithMove f dm0 dm') mapPatchDMapWithMove weakenPatchDMapWithMoveWith patchMapWithMoveNewElements mergeMapIncrementalWithMove
@@ -92,7 +92,7 @@ instance Requester t m => Requester t (EventWriterT t w m) where
9292-- 'runWithReplace' for 'EventWriterT'. This is necessary when the underlying
9393-- monad doesn't have a 'MonadAdjust' instance or to override the default
9494-- 'MonadAdjust' behavior.
95−runWithReplaceEventWriterTWith :: forall m t w a b. (Reflex t, MonadHold t m, Monoid w)
95+runWithReplaceEventWriterTWith :: forall m t w a b. (Reflex t, MonadHold t m, Semigroup w)
9696 => (forall a' b'. m a' -> Event t (m b') -> EventWriterT t w m (a', Event t b'))
9797 -> EventWriterT t w m a
9898 -> Event t (EventWriterT t w m b)
@@ -101,14 +101,14 @@ runWithReplaceEventWriterTWith f a0 a' = do
101101 let g :: EventWriterT t w m c -> m (c, Seq (Event t w))
102102 g (EventWriterT r) = runStateT r mempty
103103 (result0, result') <- f (g a0) $ fmap g a'
104− request <- holdDyn (fmapCheap (mconcat . NonEmpty.toList) $ mergeList $ toList $ snd result0) $ fmapCheap (fmapCheap (mconcat . NonEmpty.toList) . mergeList . toList . snd) result'
104+ request <- holdDyn (fmapCheap sconcat $ mergeList $ toList $ snd result0) $ fmapCheap (fmapCheap sconcat . mergeList . toList . snd) result'
105105 -- We add these two separately to take advantage of the free merge being done later. The coincidence case must come first so that it has precedence if both fire simultaneously. (Really, we should probably block the 'switch' whenever 'updated' fires, but switchPromptlyDyn has the same issue.)
106106 EventWriterT $ modify $ flip (|>) $ coincidence $ updated request
107107 EventWriterT $ modify $ flip (|>) $ switch $ current request
108108 return (fst result0, fmapCheap fst result')
109109
110110-- | Like 'runWithReplaceEventWriterTWith', but for 'sequenceDMapWithAdjust'.
111−sequenceDMapWithAdjustEventWriterTWith :: forall t m p p' w k v v'. (Reflex t, MonadHold t m, Monoid w, Semigroup w, Patch (p' (Some k) (Event t w)), PatchTarget (p' (Some k) (Event t w)) ~ Map (Some k) (Event t w))
111+sequenceDMapWithAdjustEventWriterTWith :: forall t m p p' w k v v'. (Reflex t, MonadHold t m, Semigroup w, Semigroup w, Patch (p' (Some k) (Event t w)), PatchTarget (p' (Some k) (Event t w)) ~ Map (Some k) (Event t w))
112112 => ( (forall a. k a -> v a -> m (Compose ((,) (Seq (Event t w))) v' a))
113113 -> DMap k v
114114 -> Event t (p k v)
@@ -135,7 +135,9 @@ sequenceDMapWithAdjustEventWriterTWith base mapPatch weakenPatchWith patchNewEle
135135 childRequestMap :: Incremental t (p' (Some k) (Event t w)) <- holdIncremental requests0 requests'
136136 -- We add these two separately to take advantage of the free merge being done later. The coincidence case must come first so that it has precedence if both fire simultaneously. (Really, we should probably block the 'switch' whenever 'updated' fires, but switchPromptlyDyn has the same issue.)
137137 EventWriterT $ modify $ flip (|>) $ coincidence $ fforCheap requests' $ \p -> mconcat $ patchNewElements p --TODO: Create a mergeIncrementalPromptly, and use that to eliminate this 'coincidence'
138− EventWriterT $ modify $ flip (|>) $ fold <$> mergePatchIncremental childRequestMap
138+ EventWriterT $ modify $ flip (|>) $ fforMaybeCheap (mergePatchIncremental childRequestMap) $ \m -> case toList m of
139+ [] -> Nothing
140+ h : t -> Just $ sconcat $ h :| t
139141 return (result0, result')
140142
141143instance PerformEvent t m => PerformEvent t (EventWriterT t w m) where