f8403b6 · reflex · git.iko.soy

ChangeLog.md+18−1

compare with develop

unifiedsplit

@@ -1,6 +1,23 @@

1# Revision history for reflex

2

3−## Unreleased

3+## 0.7.0.0

4+

5+* Add lifting instances for most classes to `Reflex.Profiled.Profiled`. ([#398](https://github.com/reflex-frp/reflex/pull/398))

6+* Class `MonadQuery t q m` now has a `Monad m` superclass constraint. ([#400](https://github.com/reflex-frp/reflex/pull/400))

7+* **(Breaking change)** Rename class `MonadBehaviorWriter` -> `BehaviorWriter` for consistency with `EventWriter`/`DynamicWriter`. ([#401](https://github.com/reflex-frp/reflex/pull/401))

8+* Introduce deprecated alias `MonadBehaviorWriter = BehaviorWriter`. ([#401](https://github.com/reflex-frp/reflex/pull/401))

9+* Fix bug in spider where event subscriptions would be prematurely finalized due to over-aggressive inlining. ([#409](https://github.com/reflex-frp/reflex/pull/409))

10+* Add instances of `PerformEvent` and `TriggerEvent` for `MaybeT`. ([#395](https://github.com/reflex-frp/reflex/pull/395))

11+

12+## 0.6.4.1

13+

14+* Fix a bug in the Reflex Profiled transformer where

15+ `Reflex.Class.mergeIncrementalG` and

16+ `Reflex.Class.mergeIncrementalWithMoveG` implementations referenced

17+ itself instead of the inner transformed timeline, causing an

18+ infinite loop.

19+

20+## 0.6.4

4

21

5* Support GHC 8.8

22* Support GHC 8.8

6

23

README.md+8−2

@@ -21,5 +21,11 @@ A summary of Reflex functions is available in the [quick reference](Quickref.md)

21

22### Hacking

23

24+From the root of a [Reflex

24−Use the `./scripts/hack-on reflex` script in [Reflex Platform](https://github.com/reflex-frp/reflex-platform) to checkout the source code of `reflex` locally in `reflex-platform/reflex` directory.

25+Platform](https://github.com/reflex-frp/reflex-platform) checkout, run

26+`./scripts/hack-on haskell-overlays/reflex-packages/dep/reflex`. This

27+will check out the reflex source code into the

28+`haskell-overlays/reflex-packages/dep/reflex` directory. You can then

29+point that checkout at your fork, make changes, etc. Use the

25−Then do modifications to the source in place, and use the `./try-reflex` or `./scripts/work-on` scripts to create the shell to test your changes.

30+`./try-reflex` or `./scripts/work-on` scripts to start a shell in

31+which you can test your changes.

reflex.cabal+4−1

@@ -1,5 +1,5 @@

1Name: reflex

2−Version: 0.6.3

2+Version: 0.7.0.0

3Synopsis: Higher-order Functional Reactive Programming

4Description: Reflex is a high-performance, deterministic, higher-order Functional Reactive Programming system

5License: BSD3

@@ -318,6 +318,8 @@ test-suite RequesterT

318 main-is: RequesterT.hs

319 hs-source-dirs: test

320 build-depends: base

321+ , constraints

322+ , constraints-extras

321 , containers

323 , containers

322 , constraints

324 , constraints

323 , constraints-extras

325 , constraints-extras

@@ -329,6 +331,7 @@ test-suite RequesterT

329 , primitive

331 , primitive

330 , ref-tf

332 , ref-tf

331 , reflex

333 , reflex

334+ , text

332 , these

335 , these

333 , transformers

336 , transformers

334

337

src/Reflex/BehaviorWriter/Base.hs+3−3

@@ -1,6 +1,6 @@

1{-|

2Module: Reflex.BehaviorWriter.Base

3−Description: Implementation of MonadBehaviorWriter

3+Description: Implementation of BehaviorWriter

4-}

5{-# LANGUAGE CPP #-}

6{-# LANGUAGE FlexibleInstances #-}

@@ -46,7 +46,7 @@ import Reflex.Query.Class

46import Reflex.Requester.Class

47import Reflex.TriggerEvent.Class

48

49−-- | A basic implementation of 'MonadBehaviorWriter'.

49+-- | A basic implementation of 'BehaviorWriter'.

50newtype BehaviorWriterT t w m a = BehaviorWriterT { unBehaviorWriterT :: StateT [Behavior t w] m a }

51 deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadAsyncException, MonadException) -- The list is kept in reverse order

52

@@ -89,7 +89,7 @@ instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (BehaviorWri

89 newEventWithTrigger = lift . newEventWithTrigger

90 newFanEventWithTrigger f = lift $ newFanEventWithTrigger f

91

92−instance (Monad m, Monoid w, Reflex t) => MonadBehaviorWriter t w (BehaviorWriterT t w m) where

92+instance (Monad m, Monoid w, Reflex t) => BehaviorWriter t w (BehaviorWriterT t w m) where

93 tellBehavior w = BehaviorWriterT $ modify (w :)

94

95instance MonadReader r m => MonadReader r (BehaviorWriterT t w m) where

src/Reflex/BehaviorWriter/Class.hs+11−5

@@ -1,8 +1,9 @@

1{-|

2Module: Reflex.BehaviorWriter.Class

3−Description: This module defines the 'MonadBehaviorWriter' class

3+Description: This module defines the 'BehaviorWriter' class

4-}

5{-# LANGUAGE CPP #-}

6+{-# LANGUAGE ConstraintKinds #-}

6{-# LANGUAGE FlexibleInstances #-}

7{-# LANGUAGE FlexibleInstances #-}

7{-# LANGUAGE FunctionalDependencies #-}

8{-# LANGUAGE FunctionalDependencies #-}

8{-# LANGUAGE UndecidableInstances #-}

9{-# LANGUAGE UndecidableInstances #-}

@@ -10,16 +11,21 @@ Description: This module defines the 'MonadBehaviorWriter' class

10{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

11{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

11#endif

12#endif

12module Reflex.BehaviorWriter.Class

13module Reflex.BehaviorWriter.Class

13− ( MonadBehaviorWriter (..)

14+ ( MonadBehaviorWriter

15+ , BehaviorWriter(..)

14 ) where

16 ) where

15

17

16import Control.Monad.Reader (ReaderT, lift)

18import Control.Monad.Reader (ReaderT, lift)

17import Reflex.Class (Behavior)

19import Reflex.Class (Behavior)

18

20

21+{-# DEPRECATED MonadBehaviorWriter "Use 'BehaviorWriter' instead" #-}

22+-- | Type synonym for 'BehaviorWriter'

23+type MonadBehaviorWriter = BehaviorWriter

24+

19−-- | 'MonadBehaviorWriter' efficiently collects 'Behavior' values using 'tellBehavior'

25+-- | 'BehaviorWriter' efficiently collects 'Behavior' values using 'tellBehavior'

20-- and combines them monoidally to provide a 'Behavior' result.

26-- and combines them monoidally to provide a 'Behavior' result.

21−class (Monad m, Monoid w) => MonadBehaviorWriter t w m | m -> t w where

27+class (Monad m, Monoid w) => BehaviorWriter t w m | m -> t w where

22 tellBehavior :: Behavior t w -> m ()

28 tellBehavior :: Behavior t w -> m ()

23

29

24−instance MonadBehaviorWriter t w m => MonadBehaviorWriter t w (ReaderT r m) where

30+instance BehaviorWriter t w m => BehaviorWriter t w (ReaderT r m) where

25 tellBehavior = lift . tellBehavior

31 tellBehavior = lift . tellBehavior

src/Reflex/FastWeak.hs+10

@@ -151,6 +151,16 @@ getFastWeakTicket w = do

151

152-- | Create a 'FastWeakTicket' directly from a value, creating a 'FastWeak' in the process

153-- which can be obtained with 'getFastWeakTicketValue'.

154+--

155+-- This function is marked NOINLINE so it is opaque to GHC.

156+-- If we do not do this, then GHC will sometimes fuse the constructor away

157+-- so any weak references that are attached to the ticket will have their

158+-- finalizer run. Using the opaque constructor, GHC does not see the

159+-- constructor application, so it behaves like an IORef and cannot be fused away.

160+--

161+-- The result is also evaluated to WHNF, since forcing a thunk invalidates

162+-- the weak pointer to it in some cases.

163+{-# NOINLINE mkFastWeakTicket #-}

154mkFastWeakTicket :: a -> IO (FastWeakTicket a)

164mkFastWeakTicket :: a -> IO (FastWeakTicket a)

155-- I think it's fine if this is lazy - it'll retain the 'a', but so would the output; we just need to make sure it's forced before we start relying on the

165-- I think it's fine if this is lazy - it'll retain the 'a', but so would the output; we just need to make sure it's forced before we start relying on the

156-- associated FastWeak to actually be weak

166-- associated FastWeak to actually be weak

src/Reflex/PerformEvent/Class.hs+6

@@ -22,6 +22,7 @@ import Reflex.Class

22import Reflex.TriggerEvent.Class

23

24import Control.Monad.Reader

25+import Control.Monad.Trans.Maybe (MaybeT (..))

25

26

26-- | 'PerformEvent' represents actions that can trigger other actions based on

27-- | 'PerformEvent' represents actions that can trigger other actions based on

27-- 'Event's.

28-- 'Event's.

@@ -61,3 +62,8 @@ instance PerformEvent t m => PerformEvent t (ReaderT r m) where

61 performEvent e = do

62 performEvent e = do

62 r <- ask

63 r <- ask

63 lift $ performEvent $ flip runReaderT r <$> e

64 lift $ performEvent $ flip runReaderT r <$> e

65+

66+instance PerformEvent t m => PerformEvent t (MaybeT m) where

67+ type Performable (MaybeT m) = MaybeT (Performable m)

68+ performEvent_ = lift . performEvent_ . fmapCheap (void . runMaybeT)

69+ performEvent = lift . fmap (fmapMaybe id) . performEvent . fmapCheap runMaybeT

src/Reflex/Profiled.hs+55−2

@@ -26,6 +26,7 @@ import Control.Monad.Primitive

26import Control.Monad.Reader

27import Control.Monad.Ref

28import Control.Monad.State.Strict (StateT, execStateT, modify)

29+import Data.Bifunctor

29import Data.Coerce

30import Data.Coerce

30import Data.Dependent.Map (DMap, GCompare)

31import Data.Dependent.Map (DMap, GCompare)

31import Data.FastMutableIntMap

32import Data.FastMutableIntMap

@@ -42,9 +43,18 @@ import Foreign.Ptr

42import GHC.Foreign

43import GHC.Foreign

43import GHC.IO.Encoding

44import GHC.IO.Encoding

44import GHC.Stack

45import GHC.Stack

46+import Reflex.Adjustable.Class

47+import Reflex.BehaviorWriter.Class

45import Reflex.Class

48import Reflex.Class

49+import Reflex.DynamicWriter.Class

50+import Reflex.EventWriter.Class

46import Reflex.Host.Class

51import Reflex.Host.Class

52+import Reflex.NotReady.Class

47import Reflex.PerformEvent.Class

53import Reflex.PerformEvent.Class

54+import Reflex.PostBuild.Class

55+import Reflex.Query.Class

56+import Reflex.Requester.Class

57+import Reflex.TriggerEvent.Class

48

58

49import System.IO.Unsafe

59import System.IO.Unsafe

50

60

@@ -146,8 +156,8 @@ instance Reflex t => Reflex (ProfiledTimeline t) where

146 updated (Dynamic_Profiled d) = coerce $ profileEvent $ updated d

156 updated (Dynamic_Profiled d) = coerce $ profileEvent $ updated d

147 unsafeBuildDynamic (ProfiledM a0) (Event_Profiled a') = coerce $ unsafeBuildDynamic a0 a'

157 unsafeBuildDynamic (ProfiledM a0) (Event_Profiled a') = coerce $ unsafeBuildDynamic a0 a'

148 unsafeBuildIncremental (ProfiledM a0) (Event_Profiled a') = coerce $ unsafeBuildIncremental a0 a'

158 unsafeBuildIncremental (ProfiledM a0) (Event_Profiled a') = coerce $ unsafeBuildIncremental a0 a'

149− mergeIncrementalG nt = (Event_Profiled . coerce) #. mergeIncrementalG nt

159+ mergeIncrementalG nt res = Event_Profiled $ mergeIncrementalG (coerce nt) (coerce res)

150− mergeIncrementalWithMoveG nt = (Event_Profiled . coerce) #. mergeIncrementalWithMoveG nt

160+ mergeIncrementalWithMoveG nt res = Event_Profiled $ mergeIncrementalWithMoveG (coerce nt) (coerce res)

151 currentIncremental (Incremental_Profiled i) = coerce $ currentIncremental i

161 currentIncremental (Incremental_Profiled i) = coerce $ currentIncremental i

152 updatedIncremental (Incremental_Profiled i) = coerce $ profileEvent $ updatedIncremental i

162 updatedIncremental (Incremental_Profiled i) = coerce $ profileEvent $ updatedIncremental i

153 incrementalToDynamic (Incremental_Profiled i) = coerce $ incrementalToDynamic i

163 incrementalToDynamic (Incremental_Profiled i) = coerce $ incrementalToDynamic i

@@ -177,6 +187,16 @@ instance MonadHold t m => MonadHold (ProfiledTimeline t) (ProfiledM m) where

177instance MonadSample t m => MonadSample (ProfiledTimeline t) (ProfiledM m) where

187instance MonadSample t m => MonadSample (ProfiledTimeline t) (ProfiledM m) where

178 sample (Behavior_Profiled b) = ProfiledM $ sample b

188 sample (Behavior_Profiled b) = ProfiledM $ sample b

179

189

190+instance Adjustable t m => Adjustable (ProfiledTimeline t) (ProfiledM m) where

191+ runWithReplace a0 a' = (fmap . fmap) coerce . lift $

192+ runWithReplace (coerce a0) (coerce $ coerce <$> a')

193+ traverseIntMapWithKeyWithAdjust f dm0 dm' = (fmap . fmap) coerce . lift $

194+ traverseIntMapWithKeyWithAdjust (\k v -> coerce $ f k v) dm0 (coerce dm')

195+ traverseDMapWithKeyWithAdjust f dm0 dm' = (fmap . fmap) coerce . lift $

196+ traverseDMapWithKeyWithAdjust (\k v -> coerce $ f k v) dm0 (coerce dm')

197+ traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = (fmap . fmap) coerce . lift $

198+ traverseDMapWithKeyWithAdjustWithMove (\k v -> coerce $ f k v) dm0 (coerce dm')

199+

180instance MonadTrans ProfiledM where

200instance MonadTrans ProfiledM where

181 lift = ProfiledM

201 lift = ProfiledM

182

202

@@ -188,6 +208,39 @@ instance PerformEvent t m => PerformEvent (ProfiledTimeline t) (ProfiledM m) whe

188 performEvent_ = lift . performEvent_ . coerce

208 performEvent_ = lift . performEvent_ . coerce

189 performEvent = lift . fmap coerce . performEvent . coerce

209 performEvent = lift . fmap coerce . performEvent . coerce

190

210

211+instance TriggerEvent t m => TriggerEvent (ProfiledTimeline t) (ProfiledM m) where

212+ newTriggerEvent = first coerce <$> lift newTriggerEvent

213+ newTriggerEventWithOnComplete = first coerce <$> lift newTriggerEventWithOnComplete

214+ newEventWithLazyTriggerWithOnComplete f = coerce <$> lift (newEventWithLazyTriggerWithOnComplete f)

215+

216+instance PostBuild t m => PostBuild (ProfiledTimeline t) (ProfiledM m) where

217+ getPostBuild = coerce <$> lift getPostBuild

218+

219+instance NotReady t m => NotReady (ProfiledTimeline t) (ProfiledM m) where

220+ notReady = lift notReady

221+ notReadyUntil = lift . notReadyUntil . coerce

222+

223+instance BehaviorWriter t w m => BehaviorWriter (ProfiledTimeline t) w (ProfiledM m) where

224+ tellBehavior = lift . tellBehavior . coerce

225+

226+instance DynamicWriter t w m => DynamicWriter (ProfiledTimeline t) w (ProfiledM m) where

227+ tellDyn = lift . tellDyn . coerce

228+

229+instance EventWriter t w m => EventWriter (ProfiledTimeline t) w (ProfiledM m) where

230+ tellEvent = lift . tellEvent . coerce

231+

232+instance MonadQuery t q m => MonadQuery (ProfiledTimeline t) q (ProfiledM m) where

233+ tellQueryIncremental = lift . tellQueryIncremental . coerce

234+ askQueryResult = coerce <$> lift askQueryResult

235+ queryIncremental = fmap coerce . lift . queryIncremental . coerce

236+

237+instance Requester t m => Requester (ProfiledTimeline t) (ProfiledM m) where

238+ type Request (ProfiledM m) = Request m

239+ type Response (ProfiledM m) = Response m

240+

241+ requesting = fmap coerce . lift . requesting . coerce

242+ requesting_ = lift . requesting_ . coerce

243+

191instance MonadRef m => MonadRef (ProfiledM m) where

244instance MonadRef m => MonadRef (ProfiledM m) where

192 type Ref (ProfiledM m) = Ref m

245 type Ref (ProfiledM m) = Ref m

193 newRef = lift . newRef

246 newRef = lift . newRef

src/Reflex/Query/Class.hs+5−5

@@ -125,7 +125,7 @@ instance Group SelectedCount where

125

126instance Additive SelectedCount

127

128−-- | The Semigroup/Monoid/Group instances for a Query containing 'SelectedCount's should use

128+-- | The Semigroup\/Monoid\/Group instances for a Query containing 'SelectedCount's should use

129-- this function which returns Nothing if the result is 0. This allows the pruning of leaves

130-- of the 'Query' that are no longer wanted.

131combineSelectedCounts :: SelectedCount -> SelectedCount -> Maybe SelectedCount

@@ -133,12 +133,12 @@ combineSelectedCounts (SelectedCount i) (SelectedCount j) = if i == negate j the

133

134-- | A class that allows sending of 'Query's and retrieval of 'QueryResult's. See 'queryDyn' for a commonly

135-- used interface.

136−class (Group q, Additive q, Query q) => MonadQuery t q m | m -> q t where

136+class (Group q, Additive q, Query q, Monad m) => MonadQuery t q m | m -> q t where

137 tellQueryIncremental :: Incremental t (AdditivePatch q) -> m ()

138 askQueryResult :: m (Dynamic t (QueryResult q))

139 queryIncremental :: Incremental t (AdditivePatch q) -> m (Dynamic t (QueryResult q))

140

141−instance (Monad m, MonadQuery t q m) => MonadQuery t q (ReaderT r m) where

141+instance MonadQuery t q m => MonadQuery t q (ReaderT r m) where

142 tellQueryIncremental = lift . tellQueryIncremental

143 askQueryResult = lift askQueryResult

144 queryIncremental = lift . queryIncremental

@@ -148,11 +148,11 @@ tellQueryDyn :: (Reflex t, MonadQuery t q m) => Dynamic t q -> m ()

148tellQueryDyn d = tellQueryIncremental $ unsafeBuildIncremental (sample (current d)) $ attachWith (\old new -> AdditivePatch $ new ~~ old) (current d) (updated d)

149

150-- | Retrieve 'Dynamic'ally updating 'QueryResult's for a 'Dynamic'ally updating 'Query'.

151−queryDyn :: (Reflex t, Monad m, MonadQuery t q m) => Dynamic t q -> m (Dynamic t (QueryResult q))

151+queryDyn :: (Reflex t, MonadQuery t q m) => Dynamic t q -> m (Dynamic t (QueryResult q))

152queryDyn q = do

153 tellQueryDyn q

154 zipDynWith crop q <$> askQueryResult

155

156-- | Use a query morphism to operate on a smaller version of a query.

157−subQuery :: (Reflex t, MonadQuery t q2 m, Monad m) => QueryMorphism q1 q2 -> Dynamic t q1 -> m (Dynamic t (QueryResult q1))

157+subQuery :: (Reflex t, MonadQuery t q2 m) => QueryMorphism q1 q2 -> Dynamic t q1 -> m (Dynamic t (QueryResult q1))

158subQuery (QueryMorphism f g) x = fmap g <$> queryDyn (fmap f x)

src/Reflex/Spider/Internal.hs−10

@@ -450,16 +450,6 @@ data Subscriber x a = Subscriber

450 , subscriberRecalculateHeight :: !(Height -> IO ())

451 }

452

453−--TODO: Move this comment to WeakBag

454−-- These function are constructor functions that are marked NOINLINE so they are

455−-- opaque to GHC. If we do not do this, then GHC will sometimes fuse the constructor away

456−-- so any weak references that are attached to the constructors will have their

457−-- finalizer run. Using the opaque constructor, does not see the

458−-- constructor application, so it behaves like an IORef and cannot be fused away.

459−--

460−-- The result is also evaluated to WHNF, since forcing a thunk invalidates

461−-- the weak pointer to it in some cases.

462−

463newSubscriberHold :: (HasSpiderTimeline x, Patch p) => Hold x p -> IO (Subscriber x p)

453newSubscriberHold :: (HasSpiderTimeline x, Patch p) => Hold x p -> IO (Subscriber x p)

464newSubscriberHold h = return $ Subscriber

454newSubscriberHold h = return $ Subscriber

465 { subscriberPropagate = {-# SCC "traverseHold" #-} propagateSubscriberHold h

455 { subscriberPropagate = {-# SCC "traverseHold" #-} propagateSubscriberHold h

src/Reflex/TriggerEvent/Class.hs+6

@@ -12,6 +12,7 @@ import Reflex.Class

12import Control.Monad.Reader

13import Control.Monad.State

14import qualified Control.Monad.State.Strict as Strict

15+import Control.Monad.Trans.Maybe (MaybeT)

15

16

16--TODO: Shouldn't have IO hard-coded

17--TODO: Shouldn't have IO hard-coded

17-- | 'TriggerEvent' represents actions that can create 'Event's that can be

18-- | 'TriggerEvent' represents actions that can create 'Event's that can be

@@ -47,3 +48,8 @@ instance TriggerEvent t m => TriggerEvent t (Strict.StateT s m) where

47 newTriggerEvent = lift newTriggerEvent

48 newTriggerEvent = lift newTriggerEvent

48 newTriggerEventWithOnComplete = lift newTriggerEventWithOnComplete

49 newTriggerEventWithOnComplete = lift newTriggerEventWithOnComplete

49 newEventWithLazyTriggerWithOnComplete = lift . newEventWithLazyTriggerWithOnComplete

50 newEventWithLazyTriggerWithOnComplete = lift . newEventWithLazyTriggerWithOnComplete

51+

52+instance TriggerEvent t m => TriggerEvent t (MaybeT m) where

53+ newTriggerEvent = lift newTriggerEvent

54+ newTriggerEventWithOnComplete = lift newTriggerEventWithOnComplete

55+ newEventWithLazyTriggerWithOnComplete = lift . newEventWithLazyTriggerWithOnComplete

test/Reflex/Test/CrossImpl.hs+12−7

@@ -21,6 +21,7 @@ import Reflex.Dynamic

21import Reflex.Host.Class

22import qualified Reflex.Pure as P

23import qualified Reflex.Spider.Internal as S

24+import qualified Reflex.Profiled as Prof

24

25

25import Control.Arrow (second, (&&&))

26import Control.Arrow (second, (&&&))

26import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)

27import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)

@@ -35,8 +36,6 @@ import Data.Traversable

35import System.Exit

36import System.Exit

36import System.Mem

37import System.Mem

37

38

38−import System.IO.Unsafe

39−

40mapToPureBehavior :: Map Int a -> Behavior PureReflexDomain a

39mapToPureBehavior :: Map Int a -> Behavior PureReflexDomain a

41mapToPureBehavior m = P.Behavior $ \t -> case Map.lookupLE t m of

40mapToPureBehavior m = P.Behavior $ \t -> case Map.lookupLE t m of

42 Nothing -> error $ "mapToPureBehavior: no value for time " <> show t

41 Nothing -> error $ "mapToPureBehavior: no value for time " <> show t

@@ -73,11 +72,14 @@ instance MapMSignals (Event t a) (Event t' a) t t' where

73instance (MapMSignals a a' t t', MapMSignals b b' t t') => MapMSignals (a, b) (a', b') t t' where

72instance (MapMSignals a a' t t', MapMSignals b b' t t') => MapMSignals (a, b) (a', b') t t' where

74 mapMSignals fb fe (a, b) = liftM2 (,) (mapMSignals fb fe a) (mapMSignals fb fe b)

73 mapMSignals fb fe (a, b) = liftM2 (,) (mapMSignals fb fe a) (mapMSignals fb fe b)

75

74

75+testTimeline

76−testSpider :: (forall m t. TestCaseConstraint t m => (Behavior t a, Event t b) -> m (Behavior t c, Event t d)) -> (Map Int a, Map Int b) -> (Map Int c, Map Int d)

76+ :: (forall m t. TestCaseConstraint t m => (Behavior t a, Event t b) -> m (Behavior t c, Event t d))

77+ -> (Map Int a, Map Int b)

78+ -> (forall m t. (MonadReflexHost t m, MonadIO m, MonadRef m, Ref m ~ Ref IO, MonadSample t m) => m (Map Int c, Map Int d))

77−testSpider builder (bMap, eMap) = unsafePerformIO $ S.runSpiderHost $ do

79+testTimeline builder (bMap, eMap) = do

78 (re, reTrigger) <- newEventWithTriggerRef

80 (re, reTrigger) <- newEventWithTriggerRef

79 (rb, rbTrigger) <- newEventWithTriggerRef

81 (rb, rbTrigger) <- newEventWithTriggerRef

80− b <- runHostFrame $ hold (error "testSpider: No value for input behavior yet") rb

82+ b <- runHostFrame $ hold (error "testTimeline: No value for input behavior yet") rb

81 (b', e') <- runHostFrame $ builder (b, re)

83 (b', e') <- runHostFrame $ builder (b, re)

82 e'Handle <- subscribeEvent e' --TODO: This should be unnecessary

84 e'Handle <- subscribeEvent e' --TODO: This should be unnecessary

83 let times = relevantTestingTimes (bMap, eMap)

85 let times = relevantTestingTimes (bMap, eMap)

@@ -102,9 +104,11 @@ testAgreement :: (Eq c, Eq d, Show c, Show d) => (forall m t. TestCaseConstraint

102testAgreement builder inputs = do

104testAgreement builder inputs = do

103 let identityResult = testPure builder inputs

105 let identityResult = testPure builder inputs

104 tracePerf "---------" $ return ()

106 tracePerf "---------" $ return ()

105− let spiderResult = testSpider builder inputs

107+ spiderResult <- S.runSpiderHost $ testTimeline builder inputs

108+ tracePerf "---------" $ return ()

109+ profiledResult <- S.runSpiderHost $ Prof.runProfiledM $ testTimeline builder inputs

106 tracePerf "---------" $ return ()

110 tracePerf "---------" $ return ()

107− let resultsAgree = identityResult == spiderResult

111+ let resultsAgree = identityResult == spiderResult && identityResult == profiledResult

108 if resultsAgree

112 if resultsAgree

109 then do --putStrLn "Success:"

113 then do --putStrLn "Success:"

110 --print identityResult

114 --print identityResult

@@ -112,6 +116,7 @@ testAgreement builder inputs = do

112 else do putStrLn "Failure:"

116 else do putStrLn "Failure:"

113 putStrLn $ "Pure result: " <> show identityResult

117 putStrLn $ "Pure result: " <> show identityResult

114 putStrLn $ "Spider result: " <> show spiderResult

118 putStrLn $ "Spider result: " <> show spiderResult

119+ putStrLn $ "Profiled result: " <> show profiledResult

115 return resultsAgree

120 return resultsAgree

116

121

117type TestCaseConstraint t m = (Reflex t, MonadSample t m, MonadHold t m, MonadFix m, MonadFix (PushM t))

122type TestCaseConstraint t m = (Reflex t, MonadSample t m, MonadHold t m, MonadFix m, MonadFix (PushM t))

test/RequesterT.hs+13−1

@@ -25,8 +25,13 @@ import Data.Constraint.Forall

25import qualified Data.Dependent.Map as DMap

26import Data.Dependent.Sum

27import Data.Functor.Misc

28+import Data.List (words)

28import Data.Map (Map)

29import Data.Map (Map)

29import qualified Data.Map as M

30import qualified Data.Map as M

31+#if !MIN_VERSION_these(4,11,0)

32+import Data.Semigroup ((<>))

33+#endif

34+import Data.Text (Text)

30import Data.These

35import Data.These

31import Data.List.NonEmpty.Deferred

36import Data.List.NonEmpty.Deferred

32import Text.Read (readMaybe)

37import Text.Read (readMaybe)

@@ -72,15 +77,22 @@ main = do

72 print os8

77 print os8

73 os9 <- runApp' testMoribundPerformEvent $ map Just [ 1 .. 3 ]

78 os9 <- runApp' testMoribundPerformEvent $ map Just [ 1 .. 3 ]

74 print os9

79 print os9

80+ os10 <- runApp' testMatchRequestsWithResponses [ Just $ TestRequest_Increment 1 ]

81+ print os10

82+ os11 <- runApp' testMatchRequestsWithResponses [ Just $ TestRequest_Reverse "yoyo" ]

83+ print os11

75 let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1

84 let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1

76 let ![[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]] = os2

85 let ![[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]] = os2

77 let ![[Nothing, Just [2]]] = os3

86 let ![[Nothing, Just [2]]] = os3

78 let ![[Nothing, Just [2]]] = os4

87 let ![[Nothing, Just [2]]] = os4

79 let ![[Nothing, Just [1, 2]]] = os5

88 let ![[Nothing, Just [1, 2]]] = os5

80− let ![[Nothing, Nothing]] = os6 -- TODO re-enable this test after issue #233 has been resolved

89+ -- let ![[Nothing, Nothing]] = os6 -- TODO re-enable this test after issue #233 has been resolved

81 let !(Just [(-9223372036854775808,"2")]) = M.toList <$> head (head os7)

90 let !(Just [(-9223372036854775808,"2")]) = M.toList <$> head (head os7)

82 let !(Just [(-9223372036854775808,"dcba")]) = M.toList <$> head (head os8)

91 let !(Just [(-9223372036854775808,"dcba")]) = M.toList <$> head (head os8)

83 let ![[Nothing,Just "0:1"],[Nothing,Just "1:2"],[Nothing,Just "2:3"]] = os9

92 let ![[Nothing,Just "0:1"],[Nothing,Just "1:2"],[Nothing,Just "2:3"]] = os9

93+ let !(Just [(-9223372036854775808,"2")]) = M.toList <$> head (head os10)

94+ let !(Just [(-9223372036854775808,"oyoy")]) = M.toList <$> head (head os11)

95+

84 return ()

96 return ()

85

97

86unwrapApp :: forall t m a.

98unwrapApp :: forall t m a.