f3edc58 · patch · git.iko.soy

git.iko.soy/patch

on develop help sign in

Merge pull request #206 from reflex-frp/fix-eventwritert

f3edc58Ryan Trinkle8 years ago

src/Reflex/EventWriter/Base.hs+6−9

compare with develop

unifiedsplit

@@ -154,10 +154,7 @@ runWithReplaceEventWriterTWith :: forall m t w a b. (Reflex t, MonadHold t m, Se

154 -> EventWriterT t w m (a, Event t b)

155runWithReplaceEventWriterTWith f a0 a' = do

156 (result0, result') <- f (runEventWriterT a0) $ fmapCheap runEventWriterT a'

157− request <- holdDyn (snd result0) $ fmapCheap snd result'

157+ tellEvent =<< switchHoldPromptOnly (snd result0) (fmapCheap snd result')

158− -- 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.)

159− tellEvent $ coincidence $ updated request

160− tellEvent $ switch $ current request

161 return (fst result0, fmapCheap fst result')

158 return (fst result0, fmapCheap fst result')

162

159

163-- | Like 'runWithReplaceEventWriterTWith', but for 'sequenceIntMapWithAdjust'.

160-- | Like 'runWithReplaceEventWriterTWith', but for 'sequenceIntMapWithAdjust'.

@@ -219,6 +216,7 @@ sequenceDMapWithAdjustEventWriterTWith base mapPatch weakenPatchWith patchNewEle

219tellEventsPromptly

216tellEventsPromptly

220 :: ( Foldable f

217 :: ( Foldable f

221 , Reflex t

218 , Reflex t

219+ , MonadHold t m

222 , EventWriter t w m

220 , EventWriter t w m

223 )

221 )

224 => Event t a

222 => Event t a

@@ -226,11 +224,10 @@ tellEventsPromptly

226 -> Event t (f w)

224 -> Event t (f w)

227 -> m ()

225 -> m ()

228tellEventsPromptly requests' patchNewElements mergedChildRequestMap = do

226tellEventsPromptly requests' patchNewElements mergedChildRequestMap = do

229− -- 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.)

230− tellEvent $ coincidence $ fmapCheap (mconcat . patchNewElements) requests' --TODO: Create a mergeIncrementalPromptly, and use that to eliminate this 'coincidence'

231− tellEvent $ fforMaybeCheap mergedChildRequestMap $ \m -> case toList m of

227+ let patch0 = fforMaybeCheap mergedChildRequestMap $ \m -> case toList m of

232− [] -> Nothing

228+ [] -> Nothing

233− h : t -> Just $ sconcat $ h :| t

229+ h : t -> Just $ sconcat $ h :| t

230+ tellEvent =<< switchHoldPromptOnly patch0 (fmapCheap (mconcat . patchNewElements) requests')

234

231

235instance PerformEvent t m => PerformEvent t (EventWriterT t w m) where

232instance PerformEvent t m => PerformEvent t (EventWriterT t w m) where

236 type Performable (EventWriterT t w m) = Performable m

233 type Performable (EventWriterT t w m) = Performable m

test/EventWriterT.hs+21−1

@@ -1,9 +1,11 @@

1{-# LANGUAGE FlexibleContexts #-}

2−{-# LANGUAGE GADTs #-}

2+{-# LANGUAGE RecursiveDo #-}

3+{-# LANGUAGE ScopedTypeVariables #-}

3module Main where

4module Main where

5import Control.Lens

6import Control.Lens

6import Control.Monad

7import Control.Monad

8+import Control.Monad.Fix

7import Data.These

9import Data.These

9import Reflex

11import Reflex

@@ -24,6 +26,8 @@ main = do

24 , These () ()

26 , These () ()

25 ]

27 ]

26 print os2

28 print os2

29+ os3@[[Nothing, Just [2]]] <- runApp' (unwrapApp testMoribundTellEvent) [Just ()]

30+ print os3

27 return ()

31 return ()

29unwrapApp :: (Reflex t, Monad m) => (a -> EventWriterT t [Int] m ()) -> a -> m (Event t [Int])

33unwrapApp :: (Reflex t, Monad m) => (a -> EventWriterT t [Int] m ()) -> a -> m (Event t [Int])

@@ -43,3 +47,19 @@ testSimultaneous pulse = do

43 forM_ [1,3..9] $ \i -> runWithReplace (tellEvent ([i] <$ e0)) $ ffor e1 $ \_ -> tellEvent ([i+1] <$ e0)

47 forM_ [1,3..9] $ \i -> runWithReplace (tellEvent ([i] <$ e0)) $ ffor e1 $ \_ -> tellEvent ([i+1] <$ e0)

44 return ()

48 return ()

50+-- | Test that a widget telling and event which fires at the same time it has been replaced

51+-- doesn't count along with the new widget.

52+testMoribundTellEvent

53+ :: forall t m

54+ . ( Reflex t

55+ , Adjustable t m

56+ , MonadHold t m

57+ , MonadFix m

58+ )

59+ => Event t ()

60+ -> EventWriterT t [Int] m ()

61+testMoribundTellEvent pulse = do

62+ rec let tellIntOnReplce :: Int -> EventWriterT t [Int] m ()

63+ tellIntOnReplce x = tellEvent $ [x] <$ rwrFinished

64+ (_, rwrFinished) <- runWithReplace (tellIntOnReplce 1) $ tellIntOnReplce 2 <$ pulse

65+ return ()