@@ -38,7 +38,7 @@ import qualified Data.Dependent.Map as DMap
38import Data.Foldable
38import Data.Foldable
39import Data.Functor.Compose
39import Data.Functor.Compose
40import Data.Functor.Misc
40import Data.Functor.Misc
41−import qualified Data.List.NonEmpty as NonEmpty
41+import Data.List.NonEmpty (NonEmpty (..))
42import Data.Map (Map)
42import Data.Map (Map)
43import Data.Semigroup
43import Data.Semigroup
44import Data.Sequence
44import Data.Sequence
@@ -47,7 +47,7 @@ import Data.Tuple
48-- | 'EventWriter' efficiently collects 'Event' values using 'tellEvent'
48-- | 'EventWriter' efficiently collects 'Event' values using 'tellEvent'
49-- and combines them monoidally to provide an 'Event' result.
49-- 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
51 tellEvent :: Event t w -> m ()
51 tellEvent :: Event t w -> m ()
53-- | A basic implementation of 'EventWriter'.
53-- | A basic implementation of 'EventWriter'.
@@ -60,7 +60,7 @@ runEventWriterT (EventWriterT a) = do
60 (result, requests) <- runStateT a mempty
60 (result, requests) <- runStateT a mempty
61 return (result, mconcat $ toList requests)
61 return (result, mconcat $ toList requests)
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
64 tellEvent w = EventWriterT $ modify (|> w)
64 tellEvent w = EventWriterT $ modify (|> w)
66instance EventWriter t w m => EventWriter t w (ReaderT r m) where
66instance 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
77 holdDyn v0 = lift . holdDyn v0
77 holdDyn v0 = lift . holdDyn v0
78 holdIncremental v0 = lift . holdIncremental v0
78 holdIncremental v0 = lift . holdIncremental v0
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
81 runWithReplace = runWithReplaceEventWriterTWith $ \dm0 dm' -> lift $ runWithReplace dm0 dm'
81 runWithReplace = runWithReplaceEventWriterTWith $ \dm0 dm' -> lift $ runWithReplace dm0 dm'
82 traverseDMapWithKeyWithAdjust = sequenceDMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjust f dm0 dm') mapPatchDMap weakenPatchDMapWith patchMapNewElements mergeMapIncremental
82 traverseDMapWithKeyWithAdjust = sequenceDMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjust f dm0 dm') mapPatchDMap weakenPatchDMapWith patchMapNewElements mergeMapIncremental
83 traverseDMapWithKeyWithAdjustWithMove = sequenceDMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjustWithMove f dm0 dm') mapPatchDMapWithMove weakenPatchDMapWithMoveWith patchMapWithMoveNewElements mergeMapIncrementalWithMove
83 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
92-- 'runWithReplace' for 'EventWriterT'. This is necessary when the underlying
92-- 'runWithReplace' for 'EventWriterT'. This is necessary when the underlying
93-- monad doesn't have a 'MonadAdjust' instance or to override the default
93-- monad doesn't have a 'MonadAdjust' instance or to override the default
94-- 'MonadAdjust' behavior.
94-- '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)
96 => (forall a' b'. m a' -> Event t (m b') -> EventWriterT t w m (a', Event t b'))
96 => (forall a' b'. m a' -> Event t (m b') -> EventWriterT t w m (a', Event t b'))
97 -> EventWriterT t w m a
97 -> EventWriterT t w m a
98 -> Event t (EventWriterT t w m b)
98 -> Event t (EventWriterT t w m b)
@@ -101,14 +101,14 @@ runWithReplaceEventWriterTWith f a0 a' = do
101 let g :: EventWriterT t w m c -> m (c, Seq (Event t w))
101 let g :: EventWriterT t w m c -> m (c, Seq (Event t w))
102 g (EventWriterT r) = runStateT r mempty
102 g (EventWriterT r) = runStateT r mempty
103 (result0, result') <- f (g a0) $ fmap g a'
103 (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'
105 -- 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.)
105 -- 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.)
106 EventWriterT $ modify $ flip (|>) $ coincidence $ updated request
106 EventWriterT $ modify $ flip (|>) $ coincidence $ updated request
107 EventWriterT $ modify $ flip (|>) $ switch $ current request
107 EventWriterT $ modify $ flip (|>) $ switch $ current request
108 return (fst result0, fmapCheap fst result')
108 return (fst result0, fmapCheap fst result')
110-- | Like 'runWithReplaceEventWriterTWith', but for 'sequenceDMapWithAdjust'.
110-- | 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))
112 => ( (forall a. k a -> v a -> m (Compose ((,) (Seq (Event t w))) v' a))
112 => ( (forall a. k a -> v a -> m (Compose ((,) (Seq (Event t w))) v' a))
113 -> DMap k v
113 -> DMap k v
114 -> Event t (p k v)
114 -> Event t (p k v)
@@ -135,7 +135,9 @@ sequenceDMapWithAdjustEventWriterTWith base mapPatch weakenPatchWith patchNewEle
135 childRequestMap :: Incremental t (p' (Some k) (Event t w)) <- holdIncremental requests0 requests'
135 childRequestMap :: Incremental t (p' (Some k) (Event t w)) <- holdIncremental requests0 requests'
136 -- 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.)
136 -- 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.)
137 EventWriterT $ modify $ flip (|>) $ coincidence $ fforCheap requests' $ \p -> mconcat $ patchNewElements p --TODO: Create a mergeIncrementalPromptly, and use that to eliminate this 'coincidence'
137 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
140+ h : t -> Just $ sconcat $ h :| t
139 return (result0, result')
141 return (result0, result')
141instance PerformEvent t m => PerformEvent t (EventWriterT t w m) where
143instance PerformEvent t m => PerformEvent t (EventWriterT t w m) where