@@ -78,6 +78,22 @@ module Reflex.Class
7878 , zipDynWith
7979 -- ** Accumulating state
8080 , Accumulator (..)
81+ , accumDyn
82+ , accumMDyn
83+ , accumMaybeDyn
84+ , accumMaybeMDyn
85+ , mapAccumDyn
86+ , mapAccumMDyn
87+ , mapAccumMaybeDyn
88+ , mapAccumMaybeMDyn
89+ , accumB
90+ , accumMB
91+ , accumMaybeB
92+ , accumMaybeMB
93+ , mapAccumB
94+ , mapAccumMB
95+ , mapAccumMaybeB
96+ , mapAccumMaybeMB
8197 , mapAccum_
8298 , mapAccumM_
8399 , mapAccumMaybe_
@@ -880,6 +896,12 @@ alignEventWithMaybe f ea eb =
880896
881897-- | An 'Accumulator' type can be built by accumulating occurrences of an
882898-- 'Event'.
899+#if __GLASGOW_HASKELL__ < 802
900+{-# WARNING accum "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
901+{-# WARNING accumM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
902+{-# WARNING accumMaybe "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
903+{-# WARNING accumMaybeM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}
904+#endif
883905class Reflex t => Accumulator t f | f -> t where
884906 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
885907 accum f = accumMaybe $ \v o -> Just $ f v o
@@ -896,25 +918,85 @@ class Reflex t => Accumulator t f | f -> t where
896918 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
897919 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
898920
921+accumDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Dynamic t a)
922+accumDyn f = accumMaybeDyn $ \v o -> Just $ f v o
923+accumMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Dynamic t a)
924+accumMDyn f = accumMaybeMDyn $ \v o -> Just <$> f v o
925+accumMaybeDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Dynamic t a)
926+accumMaybeDyn f = accumMaybeMDyn $ \v o -> return $ f v o
927+accumMaybeMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Dynamic t a)
928+accumMaybeMDyn f z e = do
929+ rec let e' = flip push e $ \o -> do
930+ v <- sample $ current d'
931+ f v o
932+ d' <- holdDyn z e'
933+ return d'
934+mapAccumDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
935+mapAccumDyn f = mapAccumMaybeDyn $ \v o -> bimap Just Just $ f v o
936+mapAccumMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
937+mapAccumMDyn f = mapAccumMaybeMDyn $ \v o -> bimap Just Just <$> f v o
938+mapAccumMaybeDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
939+mapAccumMaybeDyn f = mapAccumMaybeMDyn $ \v o -> return $ f v o
940+mapAccumMaybeMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Dynamic t a, Event t c)
941+mapAccumMaybeMDyn f z e = do
942+ rec let e' = flip push e $ \o -> do
943+ v <- sample $ current d'
944+ result <- f v o
945+ return $ case result of
946+ (Nothing, Nothing) -> Nothing
947+ _ -> Just result
948+ d' <- holdDyn z $ fmapMaybe fst e'
949+ return (d', fmapMaybe snd e')
950+
951+accumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Behavior t a)
952+accumB f = accumMaybeB $ \v o -> Just $ f v o
953+accumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Behavior t a)
954+accumMB f = accumMaybeMB $ \v o -> Just <$> f v o
955+accumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Behavior t a)
956+accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o
957+accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)
958+accumMaybeMB f z e = do
959+ rec let e' = flip push e $ \o -> do
960+ v <- sample d'
961+ f v o
962+ d' <- hold z e'
963+ return d'
964+mapAccumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)
965+mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o
966+mapAccumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)
967+mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o
968+mapAccumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)
969+mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o
970+mapAccumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)
971+mapAccumMaybeMB f z e = do
972+ rec let e' = flip push e $ \o -> do
973+ v <- sample d'
974+ result <- f v o
975+ return $ case result of
976+ (Nothing, Nothing) -> Nothing
977+ _ -> Just result
978+ d' <- hold z $ fmapMaybe fst e'
979+ return (d', fmapMaybe snd e')
980+
899981-- | Accumulate occurrences of an 'Event', producing an output occurrence each
900982-- time. Discard the underlying 'Accumulator'.
901983mapAccum_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Event t c)
902984mapAccum_ f z e = do
903− (_ :: Behavior t a, result) <- mapAccum f z e
985+ (_, result) <- mapAccumB f z e
904986 return result
905987
906988-- | Accumulate occurrences of an 'Event', possibly producing an output
907989-- occurrence each time. Discard the underlying 'Accumulator'.
908990mapAccumMaybe_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)
909991mapAccumMaybe_ f z e = do
910− (_ :: Behavior t a, result) <- mapAccumMaybe f z e
992+ (_, result) <- mapAccumMaybeB f z e
911993 return result
912994
913995-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
914996-- an output occurrence each time. Discard the underlying 'Accumulator'.
915997mapAccumM_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Event t c)
916998mapAccumM_ f z e = do
917− (_ :: Behavior t a, result) <- mapAccumM f z e
999+ (_, result) <- mapAccumMB f z e
9181000 return result
9191001
9201002-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
@@ -922,29 +1004,16 @@ mapAccumM_ f z e = do
9221004-- 'Accumulator'.
9231005mapAccumMaybeM_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)
9241006mapAccumMaybeM_ f z e = do
925− (_ :: Behavior t a, result) <- mapAccumMaybeM f z e
1007+ (_, result) <- mapAccumMaybeMB f z e
9261008 return result
9271009
9281010instance Reflex t => Accumulator t (Dynamic t) where
929− accumMaybeM f z e = do
930− rec let e' = flip push e $ \o -> do
931− v <- sample $ current d'
932− f v o
933− d' <- holdDyn z e'
934− return d'
935− mapAccumMaybeM f z e = do
936− rec let e' = flip push e $ \o -> do
937− v <- sample $ current d'
938− result <- f v o
939− return $ case result of
940− (Nothing, Nothing) -> Nothing
941− _ -> Just result
942− d' <- holdDyn z $ fmapMaybe fst e'
943− return (d', fmapMaybe snd e')
1011+ accumMaybeM = accumMaybeMDyn
1012+ mapAccumMaybeM = mapAccumMaybeMDyn
9441013
9451014instance Reflex t => Accumulator t (Behavior t) where
946− accumMaybeM f z e = current <$> accumMaybeM f z e
947− mapAccumMaybeM f z e = first current <$> mapAccumMaybeM f z e
1015+ accumMaybeM = accumMaybeMB
1016+ mapAccumMaybeM = mapAccumMaybeMB
9481017
9491018instance Reflex t => Accumulator t (Event t) where
9501019 accumMaybeM f z e = updated <$> accumMaybeM f z e