973759c · reflex · git.iko.soy

git.iko.soy/reflex

on develop help sign in

Add buildDynamic

973759cRyan Trinkle9 years ago

reflex.cabal+15

compare with develop

unifiedsplit

@@ -153,6 +153,21 @@ test-suite semantics

153 if flag(specialize-to-spidertimeline-global)

154 buildable: False

155

156+test-suite CrossImpl

157+ type: exitcode-stdio-1.0

158+ main-is: Reflex/Test/CrossImpl.hs

159+ hs-source-dirs: test

160+ ghc-options: -O2 -Wall -rtsopts -main-is Reflex.Test.CrossImpl.test

161+ build-depends:

162+ base,

163+ containers,

164+ dependent-map,

165+ mtl,

166+ ref-tf,

167+ reflex

168+ if flag(specialize-to-spidertimeline-global)

169+ buildable: False

170+

156test-suite hlint

171test-suite hlint

157 type: exitcode-stdio-1.0

172 type: exitcode-stdio-1.0

158 main-is: hlint.hs

173 main-is: hlint.hs

src/Reflex/Class.hs+17−4

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

1{-# LANGUAGE CPP #-}

2+{-# LANGUAGE DefaultSignatures #-}

2{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE FunctionalDependencies #-}

5{-# LANGUAGE FunctionalDependencies #-}

@@ -187,7 +188,7 @@ import Reflex.Spider.Internal (EventM, Global, HasSpiderTimeline, SpiderHost (..

187 SpiderPullM, SpiderPushM (..), behaviorHoldIdentity, dynamicConst,

188 SpiderPullM, SpiderPushM (..), behaviorHoldIdentity, dynamicConst,

188 dynamicCurrent, dynamicDynIdentity, dynamicHold, dynamicHoldIdentity,

189 dynamicCurrent, dynamicDynIdentity, dynamicHold, dynamicHoldIdentity,

189 dynamicUpdated, newMapDyn, readBehaviorTracked, readBehaviorUntracked,

190 dynamicUpdated, newMapDyn, readBehaviorTracked, readBehaviorUntracked,

190− runFrame, runSpiderHostFrame, unsafeDyn)

191+ runFrame, runSpiderHostFrame)

191import qualified Reflex.Spider.Internal

192import qualified Reflex.Spider.Internal

192import qualified Reflex.Spider.Internal as S

193import qualified Reflex.Spider.Internal as S

193import Unsafe.Coerce

194import Unsafe.Coerce

@@ -350,9 +351,9 @@ current = SpiderBehavior . S.dynamicCurrent . unSpiderDynamic

350{-# INLINE updated #-}

351{-# INLINE updated #-}

351updated = coerceEvent . SpiderEvent . dynamicUpdated . unSpiderDynamic

352updated = coerceEvent . SpiderEvent . dynamicUpdated . unSpiderDynamic

352{-# INLINE unsafeBuildDynamic #-}

353{-# INLINE unsafeBuildDynamic #-}

353−unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ unsafeDyn (coerce readV0) $ coerce $ unSpiderEvent v'

354+unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ S.unsafeBuildDynamic (coerce readV0) $ coerce $ unSpiderEvent v'

354{-# INLINE unsafeBuildIncremental #-}

355{-# INLINE unsafeBuildIncremental #-}

355−unsafeBuildIncremental readV0 dv = SpiderIncremental $ S.dynamicDyn $ unsafeDyn (coerce readV0) $ unSpiderEvent dv

356+unsafeBuildIncremental readV0 dv = SpiderIncremental $ S.dynamicDyn $ S.unsafeBuildDynamic (coerce readV0) $ unSpiderEvent dv

356{-# INLINE mergeIncremental #-}

357{-# INLINE mergeIncremental #-}

357mergeIncremental = SpiderEvent . S.merge . (unsafeCoerce :: S.Dynamic x (PatchDMap k (Event (SpiderTimeline x))) -> S.Dynamic x (PatchDMap k (S.Event x))) . unSpiderIncremental

358mergeIncremental = SpiderEvent . S.merge . (unsafeCoerce :: S.Dynamic x (PatchDMap k (Event (SpiderTimeline x))) -> S.Dynamic x (PatchDMap k (S.Event x))) . unSpiderIncremental

358{-# INLINE mergeIncrementalWithMove #-}

359{-# INLINE mergeIncrementalWithMove #-}

@@ -362,7 +363,7 @@ currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental

362{-# INLINE updatedIncremental #-}

363{-# INLINE updatedIncremental #-}

363updatedIncremental = SpiderEvent . dynamicUpdated . unSpiderIncremental

364updatedIncremental = SpiderEvent . dynamicUpdated . unSpiderIncremental

364{-# INLINE incrementalToDynamic #-}

365{-# INLINE incrementalToDynamic #-}

365−incrementalToDynamic (SpiderIncremental i) = SpiderDynamic $ dynamicDynIdentity $ unsafeDyn (readBehaviorUntracked $ dynamicCurrent i) $ flip S.push (dynamicUpdated i) $ \p -> do

366+incrementalToDynamic (SpiderIncremental i) = SpiderDynamic $ dynamicDynIdentity $ S.unsafeBuildDynamic (readBehaviorUntracked $ dynamicCurrent i) $ flip S.push (dynamicUpdated i) $ \p -> do

366 c <- readBehaviorUntracked $ dynamicCurrent i

367 c <- readBehaviorUntracked $ dynamicCurrent i

367 return $ Identity <$> apply p c

368 return $ Identity <$> apply p c

368eventCoercion Coercion = Coercion

369eventCoercion Coercion = Coercion

@@ -414,12 +415,21 @@ class MonadSample t m => MonadHold t m where

414 -- the 'Behavior', it will see the _old_ value of the 'Behavior', not the new

415 -- the 'Behavior', it will see the _old_ value of the 'Behavior', not the new

415 -- one.

416 -- one.

416 hold :: a -> Event t a -> m (Behavior t a)

417 hold :: a -> Event t a -> m (Behavior t a)

418+ default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)

419+ hold v0 = lift . hold v0

417 -- | Create a 'Dynamic' value using the given initial value that changes every

420 -- | Create a 'Dynamic' value using the given initial value that changes every

418 -- time the 'Event' occurs.

421 -- time the 'Event' occurs.

419 holdDyn :: a -> Event t a -> m (Dynamic t a)

422 holdDyn :: a -> Event t a -> m (Dynamic t a)

423+ default holdDyn :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Dynamic t a)

424+ holdDyn v0 = lift . holdDyn v0

420 -- | Create an 'Incremental' value using the given initial value that changes

425 -- | Create an 'Incremental' value using the given initial value that changes

421 -- every time the 'Event' occurs.

426 -- every time the 'Event' occurs.

422 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)

427 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)

428+ default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)

429+ holdIncremental v0 = lift . holdIncremental v0

430+ buildDynamic :: PullM t a -> Event t a -> m (Dynamic t a)

431+ default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)

432+ buildDynamic getV0 = lift . buildDynamic getV0

423

433

424-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a

434-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a

425-- key. This is much more efficient than filtering for each key with

435-- key. This is much more efficient than filtering for each key with

@@ -446,6 +456,7 @@ instance MonadHold t m => MonadHold t (ReaderT r m) where

446 hold a0 = lift . hold a0

456 hold a0 = lift . hold a0

447 holdDyn a0 = lift . holdDyn a0

457 holdDyn a0 = lift . holdDyn a0

448 holdIncremental a0 = lift . holdIncremental a0

458 holdIncremental a0 = lift . holdIncremental a0

459+ buildDynamic a0 = lift . buildDynamic a0

449

460

450instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where

461instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where

451 sample = lift . sample

462 sample = lift . sample

@@ -454,6 +465,7 @@ instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where

454 hold a0 = lift . hold a0

465 hold a0 = lift . hold a0

455 holdDyn a0 = lift . holdDyn a0

466 holdDyn a0 = lift . holdDyn a0

456 holdIncremental a0 = lift . holdIncremental a0

467 holdIncremental a0 = lift . holdIncremental a0

468+ buildDynamic a0 = lift . buildDynamic a0

457

469

458instance MonadSample t m => MonadSample t (StateT s m) where

470instance MonadSample t m => MonadSample t (StateT s m) where

459 sample = lift . sample

471 sample = lift . sample

@@ -462,6 +474,7 @@ instance MonadHold t m => MonadHold t (StateT s m) where

462 hold a0 = lift . hold a0

474 hold a0 = lift . hold a0

463 holdDyn a0 = lift . holdDyn a0

475 holdDyn a0 = lift . holdDyn a0

464 holdIncremental a0 = lift . holdIncremental a0

476 holdIncremental a0 = lift . holdIncremental a0

477+ buildDynamic a0 = lift . buildDynamic a0

465

478

466instance MonadSample t m => MonadSample t (ExceptT e m) where

479instance MonadSample t m => MonadSample t (ExceptT e m) where

467 sample = lift . sample

480 sample = lift . sample

src/Reflex/Dynamic.hs+45−11

@@ -8,6 +8,7 @@

8{-# LANGUAGE NoMonomorphismRestriction #-}

9{-# LANGUAGE PolyKinds #-}

10{-# LANGUAGE RankNTypes #-}

11+{-# LANGUAGE RecursiveDo #-}

11{-# LANGUAGE ScopedTypeVariables #-}

12{-# LANGUAGE ScopedTypeVariables #-}

12{-# LANGUAGE StandaloneDeriving #-}

13{-# LANGUAGE StandaloneDeriving #-}

13{-# LANGUAGE TypeFamilies #-}

14{-# LANGUAGE TypeFamilies #-}

@@ -25,8 +26,6 @@ module Reflex.Dynamic

25 , updated

26 , updated

26 , holdDyn

27 , holdDyn

27 , constDyn

28 , constDyn

28− , uniqDyn

29− , uniqDynBy

30 , count

29 , count

31 , toggle

30 , toggle

32 , switchPromptlyDyn

31 , switchPromptlyDyn

@@ -34,6 +33,10 @@ module Reflex.Dynamic

34 , attachPromptlyDyn

33 , attachPromptlyDyn

35 , attachPromptlyDynWith

34 , attachPromptlyDynWith

36 , attachPromptlyDynWithMaybe

35 , attachPromptlyDynWithMaybe

36+ , scanDyn

37+ , scanDynMaybe

38+ , holdUniqDyn

39+ , holdUniqDynBy

37 , foldDyn

40 , foldDyn

38 , foldDynM

41 , foldDynM

39 , foldDynMaybe

42 , foldDynMaybe

@@ -78,6 +81,8 @@ module Reflex.Dynamic

78 , nubDyn

81 , nubDyn

79 , splitDyn

82 , splitDyn

80 , tagDyn

83 , tagDyn

84+ , uniqDyn

85+ , uniqDynBy

81 ) where

86 ) where

83import Prelude hiding (mapM, mapM_)

88import Prelude hiding (mapM, mapM_)

@@ -102,16 +107,29 @@ import Debug.Trace

102

107

103-- | Create a new 'Dynamic' that only signals changes if the values actually

108-- | Create a new 'Dynamic' that only signals changes if the values actually

104-- changed.

109-- changed.

105−uniqDyn :: (Reflex t, Eq a) => Dynamic t a -> Dynamic t a

110+holdUniqDyn :: (Reflex t, MonadHold t m, MonadFix m, Eq a) => Dynamic t a -> m (Dynamic t a)

106−uniqDyn = uniqDynBy (==)

111+holdUniqDyn = holdUniqDynBy (==)

107

112

108-- | Create a new 'Dynamic' that changes only when the underlying 'Dynamic'

113-- | Create a new 'Dynamic' that changes only when the underlying 'Dynamic'

109-- changes and the given function returns 'False' when given both the old and

114-- changes and the given function returns 'False' when given both the old and

110-- the new values.

115-- the new values.

111−uniqDynBy :: Reflex t => (a -> a -> Bool) -> Dynamic t a -> Dynamic t a

116+holdUniqDynBy :: (Reflex t, MonadHold t m, MonadFix m) => (a -> a -> Bool) -> Dynamic t a -> m (Dynamic t a)

112−uniqDynBy eq d =

117+holdUniqDynBy eq = scanDynMaybe id (\new old -> if new `eq` old then Nothing else Just new)

113− let e' = attachWithMaybe (\x x' -> if x' `eq` x then Nothing else Just x') (current d) (updated d)

118+

119+-- | Create a 'Dynamic' that accumulates values from another 'Dynamic'. This

120+-- function does not force its input 'Dynamic' until the output 'Dynamic' is

121+-- forced.

122+scanDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b) -> (a -> b -> b) -> Dynamic t a -> m (Dynamic t b)

123+scanDyn z f = scanDynMaybe z (\a b -> Just $ f a b)

124+

125+-- | Like 'scanDyn', but the the accumulator function may decline to update the

126+-- result 'Dynamic''s value.

127+scanDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b) -> (a -> b -> Maybe b) -> Dynamic t a -> m (Dynamic t b)

128+scanDynMaybe z f d = do

129+ rec d' <- buildDynamic (z <$> sample (current d)) $ flip push (updated d) $ \a -> do

114− in unsafeDynamic (current d) e'

130+ b <- sample $ current d'

131+ return $ f a b

132+ return d'

115

133

116-- | Create a 'Dynamic' using the initial value and change it each time the

134-- | Create a 'Dynamic' using the initial value and change it each time the

117-- 'Event' occurs using a folding function on the previous value and the value

135-- 'Event' occurs using a folding function on the previous value and the value

@@ -594,8 +612,24 @@ attachDynWithMaybe = attachPromptlyDynWithMaybe

594joinDyn :: Reflex t => Dynamic t (Dynamic t a) -> Dynamic t a

612joinDyn :: Reflex t => Dynamic t (Dynamic t a) -> Dynamic t a

595joinDyn = join

613joinDyn = join

596

614

597−-- | 'nubDyn''s behavior is not quite analogous to 'nub''s behavior, so it has

615+-- | WARNING: This function is only pure if @a@'s 'Eq' instance tests

598−-- been renamed to 'uniqDyn'

616+-- representational equality. Use 'holdUniqDyn' instead, which is pure in all

617+-- circumstances. Also, note that, unlike 'nub', this function does not prevent

618+-- all recurrences of a value, only consecutive recurrences.

599−{-# DEPRECATED nubDyn "Use 'uniqDyn' instead" #-}

619+{-# DEPRECATED nubDyn "Use 'holdUniqDyn' instead; note that it returns a MonadHold action rather than a pure Dynamic" #-}

600nubDyn :: (Reflex t, Eq a) => Dynamic t a -> Dynamic t a

620nubDyn :: (Reflex t, Eq a) => Dynamic t a -> Dynamic t a

601nubDyn = uniqDyn

621nubDyn = uniqDyn

622+

623+-- | WARNING: This function is only pure if @a@'s 'Eq' instance tests

624+-- representational equality. Use 'holdUniqDyn' instead, which is pure in all

625+-- circumstances.

626+{-# DEPRECATED uniqDyn "Use 'holdUniqDyn' instead; note that it returns a MonadHold action rather than a pure Dynamic" #-}

627+uniqDyn :: (Reflex t, Eq a) => Dynamic t a -> Dynamic t a

628+uniqDyn = uniqDynBy (==)

629+

630+-- | WARNING: This function is impure. Use 'holdUniqDynBy' instead.

631+{-# DEPRECATED uniqDynBy "Use 'holdUniqDynBy' instead; note that it returns a MonadHold action rather than a pure Dynamic" #-}

632+uniqDynBy :: Reflex t => (a -> a -> Bool) -> Dynamic t a -> Dynamic t a

633+uniqDynBy eq d =

634+ let e' = attachWithMaybe (\x x' -> if x' `eq` x then Nothing else Just x') (current d) (updated d)

635+ in unsafeDynamic (current d) e'

src/Reflex/Dynamic/Uniq.hs+2−2

@@ -17,7 +17,6 @@ module Reflex.Dynamic.Uniq

17import Control.Applicative (Applicative (..))

18import GHC.Exts

19import Reflex.Class

20−import Reflex.Dynamic

22-- | A 'Dynamic' whose 'updated' 'Event' will never fire with the same value as

21-- | A 'Dynamic' whose 'updated' 'Event' will never fire with the same value as

23-- the 'current' 'Behavior''s contents. In order to maintain this constraint,

22-- the 'current' 'Behavior''s contents. In order to maintain this constraint,

@@ -47,7 +46,7 @@ uniqDynamic d = UniqDynamic $ unsafeBuildDynamic (sample $ current d) $ flip pus

47-- instance, but can be equal by pointer equality. This may cause 'UniqDynamic'

46-- instance, but can be equal by pointer equality. This may cause 'UniqDynamic'

48-- to lose changes from NaN to NaN.

47-- to lose changes from NaN to NaN.

49fromUniqDynamic :: (Reflex t, Eq a) => UniqDynamic t a -> Dynamic t a

48fromUniqDynamic :: (Reflex t, Eq a) => UniqDynamic t a -> Dynamic t a

50−fromUniqDynamic (UniqDynamic d) = uniqDynBy superEq d

49+fromUniqDynamic (UniqDynamic d) = unsafeDynamic (current d) e'

51 where

50 where

52 -- Only consider values different if they fail both pointer equality /and/

51 -- Only consider values different if they fail both pointer equality /and/

53 -- 'Eq' equality. This is to make things a bit more deterministic in the

52 -- 'Eq' equality. This is to make things a bit more deterministic in the

@@ -57,6 +56,7 @@ fromUniqDynamic (UniqDynamic d) = uniqDynBy superEq d

57 -- nonequal by pointer quality. I suspect that it is impossible to make the

56 -- nonequal by pointer quality. I suspect that it is impossible to make the

58 -- behavior deterministic in this case.

57 -- behavior deterministic in this case.

59 superEq a b = a `unsafePtrEq` b || a == b

58 superEq a b = a `unsafePtrEq` b || a == b

59+ e' = attachWithMaybe (\x x' -> if x' `superEq` x then Nothing else Just x') (current d) (updated d)

61-- | Create a UniqDynamic without uniqing it on creation. This will be slightly

62-- faster than uniqDynamic when used with a Dynamic whose values are always (or

src/Reflex/PerformEvent/Base.hs+2

@@ -142,6 +142,8 @@ instance (ReflexHost t, MonadHold t m) => MonadHold t (PerformEventT t m) where

142 holdDyn v0 v' = PerformEventT $ lift $ holdDyn v0 v'

143 {-# INLINABLE holdIncremental #-}

144 holdIncremental v0 v' = PerformEventT $ lift $ holdIncremental v0 v'

145+ {-# INLINABLE buildDynamic #-}

146+ buildDynamic getV0 v' = PerformEventT $ lift $ buildDynamic getV0 v'

145

147

146instance (MonadRef (HostFrame t), ReflexHost t) => MonadRef (PerformEventT t m) where

148instance (MonadRef (HostFrame t), ReflexHost t) => MonadRef (PerformEventT t m) where

147 type Ref (PerformEventT t m) = Ref (HostFrame t)

149 type Ref (PerformEventT t m) = Ref (HostFrame t)

src/Reflex/Pure.hs+5−3

@@ -169,9 +169,11 @@ instance (Enum t, HasTrie t, Ord t) => MonadHold (Pure t) ((->) t) where

169 else let lastTime = pred sampleTime

170 in fromMaybe (f lastTime) $ unEvent e lastTime

171

172+ holdDyn v0 = buildDynamic (return v0)

173+

172− holdDyn :: a -> Event (Pure t) a -> t -> Dynamic (Pure t) a

174+ buildDynamic :: (t -> a) -> Event (Pure t) a -> t -> Dynamic (Pure t) a

173− holdDyn initialValue e initialTime =

175+ buildDynamic initialValue e initialTime =

174− let Behavior f = hold initialValue e initialTime

176+ let Behavior f = hold (initialValue initialTime) e initialTime

175 in Dynamic $ \t -> (f t, unEvent e t)

177 in Dynamic $ \t -> (f t, unEvent e t)

176

178

177 holdIncremental :: Patch p => PatchTarget p -> Event (Pure t) p -> t -> Incremental (Pure t) p

179 holdIncremental :: Patch p => PatchTarget p -> Event (Pure t) p -> t -> Incremental (Pure t) p

src/Reflex/Spider/Internal.hs+47−19

@@ -747,6 +747,7 @@ instance GEq SpiderTimelineEnv where

747data EventEnv x

748 = EventEnv { eventEnvAssignments :: !(IORef [SomeAssignment x]) -- Needed for Subscribe

749 , eventEnvHoldInits :: !(IORef [SomeHoldInit x]) -- Needed for Subscribe

750+ , eventEnvDynInits :: !(IORef [SomeDynInit x])

750 , eventEnvMergeUpdates :: !(IORef [SomeMergeUpdate x])

751 , eventEnvMergeUpdates :: !(IORef [SomeMergeUpdate x])

751 , eventEnvMergeInits :: !(IORef [SomeMergeInit x]) -- Needed for Subscribe

752 , eventEnvMergeInits :: !(IORef [SomeMergeInit x]) -- Needed for Subscribe

752 , eventEnvClears :: !(IORef [SomeClear]) -- Needed for Subscribe

753 , eventEnvClears :: !(IORef [SomeClear]) -- Needed for Subscribe

@@ -780,6 +781,10 @@ instance HasSpiderTimeline x => Defer (SomeHoldInit x) (EventM x) where

780 {-# INLINE getDeferralQueue #-}

781 {-# INLINE getDeferralQueue #-}

781 getDeferralQueue = asksEventEnv eventEnvHoldInits

782 getDeferralQueue = asksEventEnv eventEnvHoldInits

782

783

784+instance HasSpiderTimeline x => Defer (SomeDynInit x) (EventM x) where

785+ {-# INLINE getDeferralQueue #-}

786+ getDeferralQueue = asksEventEnv eventEnvDynInits

787+

783instance Defer (SomeHoldInit x) (BehaviorM x) where

788instance Defer (SomeHoldInit x) (BehaviorM x) where

784 {-# INLINE getDeferralQueue #-}

789 {-# INLINE getDeferralQueue #-}

785 getDeferralQueue = BehaviorM $ asks snd

790 getDeferralQueue = BehaviorM $ asks snd

@@ -952,6 +957,8 @@ data Root x (k :: * -> *)

952

957

953data SomeHoldInit x = forall p. Patch p => SomeHoldInit !(Hold x p)

958data SomeHoldInit x = forall p. Patch p => SomeHoldInit !(Hold x p)

954

959

960+data SomeDynInit x = forall p. Patch p => SomeDynInit !(Dyn x p)

961+

955data SomeMergeUpdate x = SomeMergeUpdate

962data SomeMergeUpdate x = SomeMergeUpdate

956 { _someMergeUpdate_update :: !(EventM x [EventSubscription x])

963 { _someMergeUpdate_update :: !(EventM x [EventSubscription x])

957 , _someMergeUpdate_invalidateHeight :: !(IO ())

964 , _someMergeUpdate_invalidateHeight :: !(IO ())

@@ -963,14 +970,20 @@ newtype SomeMergeInit x = SomeMergeInit { unSomeMergeInit :: EventM x () }

963-- EventM can do everything BehaviorM can, plus create holds

970-- EventM can do everything BehaviorM can, plus create holds

964newtype EventM x a = EventM { unEventM :: IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadException, MonadAsyncException) -- The environment should be Nothing if we are not in a frame, and Just if we are - in which case it is a list of assignments to be done after the frame is over

971newtype EventM x a = EventM { unEventM :: IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadException, MonadAsyncException) -- The environment should be Nothing if we are not in a frame, and Just if we are - in which case it is a list of assignments to be done after the frame is over

965

972

966−newtype ComputeM x a = ComputeM (ReaderT (IORef [SomeHoldInit x]) IO a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

973+newtype ComputeM x a = ComputeM (ReaderT (IORef [SomeHoldInit x], IORef [SomeDynInit x]) IO a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

967

974

968instance Defer (SomeHoldInit x) (ComputeM x) where

975instance Defer (SomeHoldInit x) (ComputeM x) where

969− getDeferralQueue = ComputeM ask

976+ getDeferralQueue = ComputeM $ asks fst

977+

978+instance Defer (SomeDynInit x) (ComputeM x) where

979+ getDeferralQueue = ComputeM $ asks snd

970

980

971{-# INLINABLE runComputeM #-}

981{-# INLINABLE runComputeM #-}

972−runComputeM :: Defer (SomeHoldInit x) m => ComputeM x a -> m a

982+runComputeM :: (Defer (SomeHoldInit x) m, Defer (SomeDynInit x) m) => ComputeM x a -> m a

973−runComputeM (ComputeM a) = liftIO . runReaderT a =<< getDeferralQueue

983+runComputeM (ComputeM a) = do

984+ holds <- getDeferralQueue

985+ dyns <- getDeferralQueue

986+ liftIO $ runReaderT a (holds, dyns)

974

987

975newtype MergeSubscribedParent x a = MergeSubscribedParent { unMergeSubscribedParent :: EventSubscription x }

988newtype MergeSubscribedParent x a = MergeSubscribedParent { unMergeSubscribedParent :: EventSubscription x }

976

989

@@ -1103,7 +1116,7 @@ instance HasSpiderTimeline x => Align (Event x) where

1103newtype Dyn x p = Dyn { unDyn :: IORef (Either (BehaviorM x (PatchTarget p), Event x p) (Hold x p)) }

1116newtype Dyn x p = Dyn { unDyn :: IORef (Either (BehaviorM x (PatchTarget p), Event x p) (Hold x p)) }

1104

1117

1105newMapDyn :: HasSpiderTimeline x => (a -> b) -> Dynamic x (Identity a) -> Dynamic x (Identity b)

1118newMapDyn :: HasSpiderTimeline x => (a -> b) -> Dynamic x (Identity a) -> Dynamic x (Identity b)

1106−newMapDyn f d = dynamicDynIdentity $ unsafeDyn (fmap f $ readBehaviorTracked $ dynamicCurrent d) (Identity . f . runIdentity <$> dynamicUpdated d)

1119+newMapDyn f d = dynamicDynIdentity $ unsafeBuildDynamic (fmap f $ readBehaviorTracked $ dynamicCurrent d) (Identity . f . runIdentity <$> dynamicUpdated d)

1107

1120

1108--TODO: Avoid the duplication between this and R.zipDynWith

1121--TODO: Avoid the duplication between this and R.zipDynWith

1109zipDynWith :: HasSpiderTimeline x => (a -> b -> c) -> Dynamic x (Identity a) -> Dynamic x (Identity b) -> Dynamic x (Identity c)

1122zipDynWith :: HasSpiderTimeline x => (a -> b -> c) -> Dynamic x (Identity a) -> Dynamic x (Identity b) -> Dynamic x (Identity c)

@@ -1119,10 +1132,17 @@ zipDynWith f da db =

1119 return (a, b)

1132 return (a, b)

1120 These (Identity a) (Identity b) -> return (a, b)

1133 These (Identity a) (Identity b) -> return (a, b)

1121 return $ Just $ Identity $ f a b

1134 return $ Just $ Identity $ f a b

1122− in dynamicDynIdentity $ unsafeDyn (f <$> readBehaviorUntracked (dynamicCurrent da) <*> readBehaviorUntracked (dynamicCurrent db)) ec

1135+ in dynamicDynIdentity $ unsafeBuildDynamic (f <$> readBehaviorUntracked (dynamicCurrent da) <*> readBehaviorUntracked (dynamicCurrent db)) ec

1136+

1137+buildDynamic :: (Defer (SomeDynInit x) m, Patch p) => BehaviorM x (PatchTarget p) -> Event x p -> m (Dyn x p)

1138+buildDynamic readV0 v' = do

1139+ result <- liftIO $ newIORef $ Left (readV0, v')

1140+ let !d = Dyn result

1141+ defer $ SomeDynInit d

1142+ return d

1123

1143

1124−unsafeDyn :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p

1144+unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p

1125−unsafeDyn readV0 v' = Dyn $ unsafeNewIORef x $ Left x

1145+unsafeBuildDynamic readV0 v' = Dyn $ unsafeNewIORef x $ Left x

1126 where x = (readV0, v')

1146 where x = (readV0, v')

1127

1147

1128-- ResultM can read behaviors and events

1148-- ResultM can read behaviors and events

@@ -1796,24 +1816,31 @@ fan e =

1796 }

1816 }

1797 in EventSelector $ \k -> eventFan k f

1817 in EventSelector $ \k -> eventFan k f

1798

1818

1799−runHoldInits :: HasSpiderTimeline x => IORef [SomeHoldInit x] -> IORef [SomeMergeInit x] -> EventM x ()

1819+runHoldInits :: HasSpiderTimeline x => IORef [SomeHoldInit x] -> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()

1800−runHoldInits holdInitRef mergeInitRef = do

1820+runHoldInits holdInitRef dynInitRef mergeInitRef = do

1801 holdInits <- liftIO $ readIORef holdInitRef

1821 holdInits <- liftIO $ readIORef holdInitRef

1822+ dynInits <- liftIO $ readIORef dynInitRef

1802 mergeInits <- liftIO $ readIORef mergeInitRef

1823 mergeInits <- liftIO $ readIORef mergeInitRef

1803− unless (null holdInits && null mergeInits) $ do

1824+ unless (null holdInits && null dynInits && null mergeInits) $ do

1804 liftIO $ writeIORef holdInitRef []

1825 liftIO $ writeIORef holdInitRef []

1826+ liftIO $ writeIORef dynInitRef []

1805 liftIO $ writeIORef mergeInitRef []

1827 liftIO $ writeIORef mergeInitRef []

1806 mapM_ initHold holdInits

1828 mapM_ initHold holdInits

1829+ mapM_ initDyn dynInits

1807 mapM_ unSomeMergeInit mergeInits

1830 mapM_ unSomeMergeInit mergeInits

1808− runHoldInits holdInitRef mergeInitRef

1831+ runHoldInits holdInitRef dynInitRef mergeInitRef

1809

1832

1810initHold :: HasSpiderTimeline x => SomeHoldInit x -> EventM x ()

1833initHold :: HasSpiderTimeline x => SomeHoldInit x -> EventM x ()

1811initHold (SomeHoldInit h) = void $ getHoldEventSubscription h

1834initHold (SomeHoldInit h) = void $ getHoldEventSubscription h

1812

1835

1836+initDyn :: HasSpiderTimeline x => SomeDynInit x -> EventM x ()

1837+initDyn (SomeDynInit d) = void $ getDynHold d

1838+

1813newEventEnv :: IO (EventEnv x)

1839newEventEnv :: IO (EventEnv x)

1814newEventEnv = do

1840newEventEnv = do

1815 toAssignRef <- newIORef [] -- This should only actually get used when events are firing

1841 toAssignRef <- newIORef [] -- This should only actually get used when events are firing

1816 holdInitRef <- newIORef []

1842 holdInitRef <- newIORef []

1843+ dynInitRef <- newIORef []

1817 mergeUpdateRef <- newIORef []

1844 mergeUpdateRef <- newIORef []

1818 mergeInitRef <- newIORef []

1845 mergeInitRef <- newIORef []

1819 heightRef <- newIORef zeroHeight

1846 heightRef <- newIORef zeroHeight

@@ -1821,12 +1848,13 @@ newEventEnv = do

1821 toClearRootRef <- newIORef []

1848 toClearRootRef <- newIORef []

1822 coincidenceInfosRef <- newIORef []

1849 coincidenceInfosRef <- newIORef []

1823 delayedRef <- newIORef IntMap.empty

1850 delayedRef <- newIORef IntMap.empty

1824− return $ EventEnv toAssignRef holdInitRef mergeUpdateRef mergeInitRef toClearRef toClearRootRef heightRef coincidenceInfosRef delayedRef

1851+ return $ EventEnv toAssignRef holdInitRef dynInitRef mergeUpdateRef mergeInitRef toClearRef toClearRootRef heightRef coincidenceInfosRef delayedRef

1825

1852

1826clearEventEnv :: EventEnv x -> IO ()

1853clearEventEnv :: EventEnv x -> IO ()

1827−clearEventEnv (EventEnv toAssignRef holdInitRef mergeUpdateRef mergeInitRef toClearRef toClearRootRef heightRef coincidenceInfosRef delayedRef) = do

1854+clearEventEnv (EventEnv toAssignRef holdInitRef dynInitRef mergeUpdateRef mergeInitRef toClearRef toClearRootRef heightRef coincidenceInfosRef delayedRef) = do

1828 writeIORef toAssignRef []

1855 writeIORef toAssignRef []

1829 writeIORef holdInitRef []

1856 writeIORef holdInitRef []

1857+ writeIORef dynInitRef []

1830 writeIORef mergeUpdateRef []

1858 writeIORef mergeUpdateRef []

1831 writeIORef mergeInitRef []

1859 writeIORef mergeInitRef []

1832 writeIORef heightRef zeroHeight

1860 writeIORef heightRef zeroHeight

@@ -1841,7 +1869,7 @@ runFrame a = SpiderHost $ ask >>= \_ -> lift $ do

1841 let env = _spiderTimeline_eventEnv (spiderTimeline :: SpiderTimelineEnv x)

1869 let env = _spiderTimeline_eventEnv (spiderTimeline :: SpiderTimelineEnv x)

1842 let go = do

1870 let go = do

1843 result <- a

1871 result <- a

1844− runHoldInits (eventEnvHoldInits env) (eventEnvMergeInits env) -- This must happen before doing the assignments, in case subscribing a Hold causes existing Holds to be read by the newly-propagated events

1872+ runHoldInits (eventEnvHoldInits env) (eventEnvDynInits env) (eventEnvMergeInits env) -- This must happen before doing the assignments, in case subscribing a Hold causes existing Holds to be read by the newly-propagated events

1845 return result

1873 return result

1846 result <- runEventM go

1874 result <- runEventM go

1847 toClear <- readIORef $ eventEnvClears env

1875 toClear <- readIORef $ eventEnvClears env

@@ -1873,7 +1901,7 @@ runFrame a = SpiderHost $ ask >>= \_ -> lift $ do

1873 writeIORef (switchSubscribedBehaviorParents subscribed) []

1901 writeIORef (switchSubscribedBehaviorParents subscribed) []

1874 writeIORef (eventEnvHoldInits env) [] --TODO: Should we reuse this?

1902 writeIORef (eventEnvHoldInits env) [] --TODO: Should we reuse this?

1875 e <- runBehaviorM (readBehaviorTracked (switchSubscribedParent subscribed)) (Just (wi', switchSubscribedBehaviorParents subscribed)) $ eventEnvHoldInits env

1903 e <- runBehaviorM (readBehaviorTracked (switchSubscribedParent subscribed)) (Just (wi', switchSubscribedBehaviorParents subscribed)) $ eventEnvHoldInits env

1876− runEventM $ runHoldInits (eventEnvHoldInits env) (eventEnvMergeInits env) --TODO: Is this actually OK? It seems like it should be, since we know that no events are firing at this point, but it still seems inelegant

1904+ runEventM $ runHoldInits (eventEnvHoldInits env) (eventEnvDynInits env) (eventEnvMergeInits env) --TODO: Is this actually OK? It seems like it should be, since we know that no events are firing at this point, but it still seems inelegant

1877 --TODO: Make sure we touch the pieces of the SwitchSubscribed at the appropriate times

1905 --TODO: Make sure we touch the pieces of the SwitchSubscribed at the appropriate times

1878 sub <- newSubscriberSwitch subscribed

1906 sub <- newSubscriberSwitch subscribed

1879 subscription <- runReaderT (unSpiderHost (runFrame ({-# SCC "subscribeSwitch" #-} subscribe e sub))) spiderTimeline --TODO: Assert that the event isn't firing --TODO: This should not loop because none of the events should be firing, but still, it is inefficient

1907 subscription <- runReaderT (unSpiderHost (runFrame ({-# SCC "subscribeSwitch" #-} subscribe e sub))) spiderTimeline --TODO: Assert that the event isn't firing --TODO: This should not loop because none of the events should be firing, but still, it is inefficient

@@ -2074,9 +2102,9 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where

2074 {-# INLINABLE updated #-}

2102 {-# INLINABLE updated #-}

2075 updated = coerce $ SpiderEvent . dynamicUpdated . unSpiderDynamic

2103 updated = coerce $ SpiderEvent . dynamicUpdated . unSpiderDynamic

2076 {-# INLINABLE unsafeBuildDynamic #-}

2104 {-# INLINABLE unsafeBuildDynamic #-}

2077− unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ unsafeDyn (coerce readV0) $ coerce $ unSpiderEvent v'

2105+ unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ unsafeBuildDynamic (coerce readV0) $ coerce $ unSpiderEvent v'

2078 {-# INLINABLE unsafeBuildIncremental #-}

2106 {-# INLINABLE unsafeBuildIncremental #-}

2079− unsafeBuildIncremental readV0 dv = SpiderIncremental $ dynamicDyn $ unsafeDyn (coerce readV0) $ unSpiderEvent dv

2107+ unsafeBuildIncremental readV0 dv = SpiderIncremental $ dynamicDyn $ unsafeBuildDynamic (coerce readV0) $ unSpiderEvent dv

2080 {-# INLINABLE mergeIncremental #-}

2108 {-# INLINABLE mergeIncremental #-}

2081 mergeIncremental = SpiderEvent . merge . (unsafeCoerce :: Dynamic x (PatchDMap k (R.Event (SpiderTimeline x))) -> Dynamic x (PatchDMap k (Event x))) . unSpiderIncremental

2109 mergeIncremental = SpiderEvent . merge . (unsafeCoerce :: Dynamic x (PatchDMap k (R.Event (SpiderTimeline x))) -> Dynamic x (PatchDMap k (Event x))) . unSpiderIncremental

2082 {-# INLINABLE mergeIncrementalWithMove #-}

2110 {-# INLINABLE mergeIncrementalWithMove #-}

@@ -2086,7 +2114,7 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where

2086 {-# INLINABLE updatedIncremental #-}

2114 {-# INLINABLE updatedIncremental #-}

2087 updatedIncremental = SpiderEvent . dynamicUpdated . unSpiderIncremental

2115 updatedIncremental = SpiderEvent . dynamicUpdated . unSpiderIncremental

2088 {-# INLINABLE incrementalToDynamic #-}

2116 {-# INLINABLE incrementalToDynamic #-}

2089− incrementalToDynamic (SpiderIncremental i) = SpiderDynamic $ dynamicDynIdentity $ unsafeDyn (readBehaviorUntracked $ dynamicCurrent i) $ flip push (dynamicUpdated i) $ \p -> do

2117+ incrementalToDynamic (SpiderIncremental i) = SpiderDynamic $ dynamicDynIdentity $ unsafeBuildDynamic (readBehaviorUntracked $ dynamicCurrent i) $ flip push (dynamicUpdated i) $ \p -> do

2090 c <- readBehaviorUntracked $ dynamicCurrent i

2118 c <- readBehaviorUntracked $ dynamicCurrent i

2091 return $ Identity <$> apply p c --TODO: Avoid the redundant 'apply'

2119 return $ Identity <$> apply p c --TODO: Avoid the redundant 'apply'

2092 eventCoercion Coercion = Coercion

2120 eventCoercion Coercion = Coercion

src/Reflex/Spider/SpiderTimeline.include.hs+14−1

@@ -16,6 +16,8 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Event

16 holdDyn = holdDynSpiderEventM

17 {-# INLINABLE holdIncremental #-}

18 holdIncremental = holdIncrementalSpiderEventM

19+ {-# INLINABLE buildDynamic #-}

20+ buildDynamic = buildDynamicSpiderEventM

20instance (

22instance (

21#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

23#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

@@ -40,6 +42,8 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide

40 holdDyn v0 (SpiderEvent e) = SpiderPushM $ fmap (SpiderDynamic . dynamicHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce e

42 holdDyn v0 (SpiderEvent e) = SpiderPushM $ fmap (SpiderDynamic . dynamicHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce e

41 {-# INLINABLE holdIncremental #-}

43 {-# INLINABLE holdIncremental #-}

42 holdIncremental v0 (SpiderEvent e) = SpiderPushM $ SpiderIncremental . dynamicHold <$> Reflex.Spider.Internal.hold v0 e

44 holdIncremental v0 (SpiderEvent e) = SpiderPushM $ SpiderIncremental . dynamicHold <$> Reflex.Spider.Internal.hold v0 e

45+ {-# INLINABLE buildDynamic #-}

46+ buildDynamic getV0 (SpiderEvent e) = SpiderPushM $ fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce e

44instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x)) where

48instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x)) where

45 {-# INLINE return #-}

49 {-# INLINE return #-}

@@ -58,7 +62,7 @@ newJoinDyn d =

58 eInner = Reflex.Spider.Internal.switch $ dynamicUpdated <$> dynamicCurrent d

62 eInner = Reflex.Spider.Internal.switch $ dynamicUpdated <$> dynamicCurrent d

59 eBoth = Reflex.Spider.Internal.coincidence $ dynamicUpdated . runIdentity <$> dynamicUpdated d

63 eBoth = Reflex.Spider.Internal.coincidence $ dynamicUpdated . runIdentity <$> dynamicUpdated d

60 v' = unSpiderEvent $ Reflex.Class.leftmost $ map SpiderEvent [eBoth, eOuter, eInner]

64 v' = unSpiderEvent $ Reflex.Class.leftmost $ map SpiderEvent [eBoth, eOuter, eInner]

61− in unsafeDyn readV0 v'

65+ in Reflex.Spider.Internal.unsafeBuildDynamic readV0 v'

63instance HasSpiderTimeline x => Functor (Reflex.Class.Dynamic (SpiderTimeline x)) where

67instance HasSpiderTimeline x => Functor (Reflex.Class.Dynamic (SpiderTimeline x)) where

64 fmap f = SpiderDynamic . newMapDyn f . unSpiderDynamic

68 fmap f = SpiderDynamic . newMapDyn f . unSpiderDynamic

@@ -78,6 +82,9 @@ holdDynSpiderEventM v0 e = fmap (SpiderDynamic . dynamicHoldIdentity) $ Reflex.S

78holdIncrementalSpiderEventM :: (HasSpiderTimeline x, Patch p) => PatchTarget p -> Reflex.Class.Event (SpiderTimeline x) p -> EventM x (Reflex.Class.Incremental (SpiderTimeline x) p)

82holdIncrementalSpiderEventM :: (HasSpiderTimeline x, Patch p) => PatchTarget p -> Reflex.Class.Event (SpiderTimeline x) p -> EventM x (Reflex.Class.Incremental (SpiderTimeline x) p)

79holdIncrementalSpiderEventM v0 e = fmap (SpiderIncremental . dynamicHold) $ Reflex.Spider.Internal.hold v0 $ unSpiderEvent e

83holdIncrementalSpiderEventM v0 e = fmap (SpiderIncremental . dynamicHold) $ Reflex.Spider.Internal.hold v0 $ unSpiderEvent e

85+buildDynamicSpiderEventM :: HasSpiderTimeline x => SpiderPullM x a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Dynamic (SpiderTimeline x) a)

86+buildDynamicSpiderEventM getV0 e = fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce $ unSpiderEvent e

87+

81instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (SpiderHost x) where

88instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (SpiderHost x) where

82 {-# INLINABLE hold #-}

89 {-# INLINABLE hold #-}

83 hold v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.hold v0 e

90 hold v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.hold v0 e

@@ -85,6 +92,8 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide

85 holdDyn v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.holdDyn v0 e

92 holdDyn v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.holdDyn v0 e

86 {-# INLINABLE holdIncremental #-}

93 {-# INLINABLE holdIncremental #-}

87 holdIncremental v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.holdIncremental v0 e

94 holdIncremental v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.holdIncremental v0 e

95+ {-# INLINABLE buildDynamic #-}

96+ buildDynamic getV0 e = runFrame . runSpiderHostFrame $ Reflex.Class.buildDynamic getV0 e

89instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHostFrame x) where

98instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHostFrame x) where

90 sample = SpiderHostFrame . readBehaviorUntracked . unSpiderBehavior --TODO: This can cause problems with laziness, so we should get rid of it if we can

99 sample = SpiderHostFrame . readBehaviorUntracked . unSpiderBehavior --TODO: This can cause problems with laziness, so we should get rid of it if we can

@@ -96,6 +105,8 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide

96 holdDyn v0 e = SpiderHostFrame $ fmap (SpiderDynamic . dynamicHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce $ unSpiderEvent e

105 holdDyn v0 e = SpiderHostFrame $ fmap (SpiderDynamic . dynamicHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce $ unSpiderEvent e

97 {-# INLINABLE holdIncremental #-}

106 {-# INLINABLE holdIncremental #-}

98 holdIncremental v0 e = SpiderHostFrame $ fmap (SpiderIncremental . dynamicHold) $ Reflex.Spider.Internal.hold v0 $ unSpiderEvent e

107 holdIncremental v0 e = SpiderHostFrame $ fmap (SpiderIncremental . dynamicHold) $ Reflex.Spider.Internal.hold v0 $ unSpiderEvent e

108+ {-# INLINABLE buildDynamic #-}

109+ buildDynamic getV0 e = SpiderHostFrame $ fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce $ unSpiderEvent e

110

100instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHost x) where

111instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHost x) where

101 {-# INLINABLE sample #-}

112 {-# INLINABLE sample #-}

@@ -112,6 +123,8 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Refle

112 holdDyn v0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.holdDyn v0 e

123 holdDyn v0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.holdDyn v0 e

113 {-# INLINABLE holdIncremental #-}

124 {-# INLINABLE holdIncremental #-}

114 holdIncremental v0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.holdIncremental v0 e

125 holdIncremental v0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.holdIncremental v0 e

126+ {-# INLINABLE buildDynamic #-}

127+ buildDynamic getV0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.buildDynamic getV0 e

115

128

116--------------------------------------------------------------------------------

129--------------------------------------------------------------------------------

117-- Deprecated items

130-- Deprecated items

test/Reflex/Plan/Pure.hs+1

@@ -39,6 +39,7 @@ instance MonadHold (Pure Int) PurePlan where

39 hold initial = liftPlan . hold initial

40 holdDyn initial = liftPlan . holdDyn initial

41 holdIncremental initial = liftPlan . holdIncremental initial

42+ buildDynamic getInitial = liftPlan . buildDynamic getInitial

43instance MonadSample (Pure Int) PurePlan where

44instance MonadSample (Pure Int) PurePlan where

44 sample = liftPlan . sample

45 sample = liftPlan . sample

test/Reflex/Test/CrossImpl.hs+7

@@ -7,6 +7,7 @@

7{-# LANGUAGE MultiParamTypeClasses #-}

8{-# LANGUAGE NoMonomorphismRestriction #-}

9{-# LANGUAGE RankNTypes #-}

10+{-# LANGUAGE RecursiveDo #-}

10{-# LANGUAGE ScopedTypeVariables #-}

11{-# LANGUAGE ScopedTypeVariables #-}

11{-# LANGUAGE TypeFamilies #-}

12{-# LANGUAGE TypeFamilies #-}

12{-# LANGUAGE TypeOperators #-}

13{-# LANGUAGE TypeOperators #-}

@@ -228,10 +229,16 @@ testCases =

228 let eInner = switch bd

229 let eInner = switch bd

229 e' = leftmost [eOuter, eInner]

230 e' = leftmost [eOuter, eInner]

230 return (b, e')

231 return (b, e')

232+ , (,) "holdUniqDyn-laziness" $ TestCase (Map.singleton 0 (0 :: Int), Map.fromList (zip [1 :: Int ..] [1 :: Int, 2, 2, 3, 3, 3, 4, 4, 4, 4])) $ \(_, e :: Event t Int) -> do

233+ rec result <- holdUniqDyn d

234+ d <- holdDyn (0 :: Int) e

235+ return (current result, updated result)

236+ {-

231 , (,) "mergeIncrementalWithMove" $ TestCase (Map.singleton 0 (0 :: Int), Map.fromList [(1, PatchDMapWithMove.moveDMapKey LeftTag RightTag), (2, mempty)]) $ \(b, e :: Event t (PatchDMapWithMove (EitherTag () ()) (Const2 () ()))) -> do

237 , (,) "mergeIncrementalWithMove" $ TestCase (Map.singleton 0 (0 :: Int), Map.fromList [(1, PatchDMapWithMove.moveDMapKey LeftTag RightTag), (2, mempty)]) $ \(b, e :: Event t (PatchDMapWithMove (EitherTag () ()) (Const2 () ()))) -> do

232 x <- holdIncremental (DMap.singleton LeftTag $ void e) $ PatchDMapWithMove.mapPatchDMapWithMove (\(Const2 _) -> void e) <$> e

238 x <- holdIncremental (DMap.singleton LeftTag $ void e) $ PatchDMapWithMove.mapPatchDMapWithMove (\(Const2 _) -> void e) <$> e

233 let e' = mergeIncrementalWithMove x :: Event t (DMap (EitherTag () ()) Identity)

239 let e' = mergeIncrementalWithMove x :: Event t (DMap (EitherTag () ()) Identity)

234 return (b, e')

240 return (b, e')

241+ -}

235 ]

242 ]

236

243

237splitRecombineEvent :: Reflex t => Event t a -> Event t String

244splitRecombineEvent :: Reflex t => Event t a -> Event t String