e54b4a1 · reflex · git.iko.soy

git.iko.soy/reflex

Factor out Reflex.Patch

commite54b4a194a9b2e6c4082734456fc12e12c88c394 authorRyan Trinkle <ryan.trinkle@gmail.com> dateSat 29 Oct 2016, 21:43 (10 years ago) parent84c1787

8 files changed+128−108

compare with develop

unifiedsplit

src/Reflex.hs+1 src/Reflex/Class.hs+2−80 src/Reflex/DynamicWriter.hs+2−1 src/Reflex/Patch.hs+92 src/Reflex/PerformEvent/Base.hs+2−1 src/Reflex/PostBuild/Class.hs+1 src/Reflex/Pure.hs+1 src/Reflex/Spider/Internal.hs+27−26

src/Reflex.hs+1

@@ -7,6 +7,7 @@ import Reflex.Dynamic as X

77import Reflex.Dynamic.TH as X

88import Reflex.Dynamic.Uniq as X

99import Reflex.DynamicWriter as X

10+import Reflex.Patch as X

1011import Reflex.PerformEvent.Class as X

1112import Reflex.PostBuild.Class as X

1213import Reflex.Spider as X

src/Reflex/Class.hs+2−80

@@ -30,10 +30,6 @@ module Reflex.Class

3030 -- ** 'fan'-related types

3131 , EventSelector (..)

3232 -- ** 'Incremental'-related types

33− , Patch (..)

34− , PatchDMap (..)

35− , ComposeMaybe (..)

36− , PatchMap (..)

3733 -- * Convenience functions

3834 , constDyn

3935 , pushAlways

@@ -113,21 +109,20 @@ import Data.Either

113109import Data.Foldable

114110import Data.Functor.Bind hiding (join)

115111import qualified Data.Functor.Bind as Bind

116−import Data.Functor.Constant

117112import Data.Functor.Misc

118113import Data.Functor.Plus

119114import Data.GADT.Compare ((:~:) (..), GEq (..))

120115import Data.GADT.Show (GShow (..))

121116import Data.List.NonEmpty (NonEmpty (..))

122117import Data.Map (Map)

123−import qualified Data.Map as Map

124118import Data.Maybe

125119import Data.Monoid hiding (Alt, (<>))

126−import Data.Semigroup (Semigroup, sconcat, stimes, stimesIdempotentMonoid, (<>))

120+import Data.Semigroup (Semigroup, sconcat, stimes, (<>))

127121import Data.String

128122import Data.These

129123import Data.Traversable

130124import Data.Type.Coercion

125+import Reflex.Patch

131126

132127-- Note: must come last to silence warnings due to AMP on GHC < 7.10

133128import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)

@@ -233,79 +228,6 @@ coerceEvent = coerceWith $ eventCoercion Coercion

233228coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b

234229coerceDynamic = coerceWith $ dynamicCoercion Coercion

235230

236−-- | A 'Patch' type represents a kind of change made to a datastructure.

237−class Patch p where

238− type PatchTarget p :: *

239− -- | Apply the patch @p a@ to the value @a@. If no change is needed, return

240− -- 'Nothing'.

241− apply :: p -> PatchTarget p -> Maybe (PatchTarget p)

242−

243−-- | We can't use @Compose Maybe@ instead of 'ComposeMaybe', because that would

244−-- make the 'f' parameter have a nominal type role. We need f to be

245−-- representational so that we can use safe 'coerce'.

246−newtype ComposeMaybe f a = ComposeMaybe { getComposeMaybe :: Maybe (f a) }

247−

248−deriving instance Functor f => Functor (ComposeMaybe f)

249−

250−instance Patch (Identity a) where

251− type PatchTarget (Identity a) = a

252− apply (Identity a) _ = Just a

253−

254−-- | A set of changes to a 'DMap'. Only DMap types are allowed for @a@.

255−newtype PatchDMap k v = PatchDMap (DMap k (ComposeMaybe v))

256−

257−instance GCompare k => Semigroup (PatchDMap k v) where

258− PatchDMap a <> PatchDMap b = PatchDMap $ a `mappend` b --TODO: Add a semigroup instance for DMap

259− -- PatchDMap is idempotent, so stimes n is id for every n

260−#if MIN_VERSION_semigroups(0,17,0)

261− stimes = stimesIdempotentMonoid

262−#else

263− times1p n x = case compare n 0 of

264− LT -> error "stimesIdempotentMonoid: negative multiplier"

265− EQ -> mempty

266− GT -> x

267−#endif

268−

269−instance GCompare k => Monoid (PatchDMap k v) where

270− mempty = PatchDMap mempty

271− mappend = (<>)

272−

273−instance GCompare k => Patch (PatchDMap k v) where

274− type PatchTarget (PatchDMap k v) = DMap k v

275− apply (PatchDMap diff) old = Just $! insertions `DMap.union` (old `DMap.difference` deletions) --TODO: return Nothing sometimes --Note: the strict application here is critical to ensuring that incremental merges don't hold onto all their prerequisite events forever; can we make this more robust?

276− where insertions = DMap.mapMaybeWithKey (const $ getComposeMaybe) diff

277− deletions = DMap.mapMaybeWithKey (const $ nothingToJust . getComposeMaybe) diff

278− nothingToJust = \case

279− Nothing -> Just $ Constant ()

280− Just _ -> Nothing

281−

282−newtype PatchMap k v = PatchMap (Map k (Maybe v))

283−

284−instance Ord k => Patch (PatchMap k v) where

285− type PatchTarget (PatchMap k v) = Map k v

286− apply (PatchMap p) old = Just $! insertions `Map.union` (old `Map.difference` deletions) --TODO: return Nothing sometimes --Note: the strict application here is critical to ensuring that incremental merges don't hold onto all their prerequisite events forever; can we make this more robust?

287− where insertions = Map.mapMaybeWithKey (const id) p

288− deletions = Map.mapMaybeWithKey (const nothingToJust) p

289− nothingToJust = \case

290− Nothing -> Just ()

291− Just _ -> Nothing

292−

293−instance Ord k => Semigroup (PatchMap k v) where

294− PatchMap a <> PatchMap b = PatchMap $ a `mappend` b --TODO: Add a semigroup instance for Map

295− -- PatchMap is idempotent, so stimes n is id for every n

296−#if MIN_VERSION_semigroups(0,17,0)

297− stimes = stimesIdempotentMonoid

298−#else

299− times1p n x = case compare n 0 of

300− LT -> error "stimesIdempotentMonoid: negative multiplier"

301− EQ -> mempty

302− GT -> x

303−#endif

304−

305−instance Ord k => Monoid (PatchMap k v) where

306− mempty = PatchMap mempty

307− mappend = (<>)

308−

309231-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'

310232-- _must_ change when and only when the 'Event' fires, such that the

311233-- 'Behavior''s value is always equal to the most recent firing of the 'Event';

src/Reflex/DynamicWriter.hs+2−1

@@ -28,9 +28,10 @@ import Data.Some (Some)

2828import qualified Data.Some as Some

2929import Reflex.Class

3030import Reflex.Dynamic

31+import Reflex.Host.Class

32+import Reflex.Patch

3133import Reflex.PerformEvent.Class

3234import Reflex.PostBuild.Class

33−import Reflex.Host.Class

3435

3536instance MonadTrans (DynamicWriterT t w) where

3637 lift = DynamicWriterT . lift

src/Reflex/Patch.hsnew file+92

@@ -0,0 +1,92 @@

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE LambdaCase #-}

3+{-# LANGUAGE StandaloneDeriving #-}

4+{-# LANGUAGE TypeFamilies #-}

5+{-# LANGUAGE DeriveFunctor #-}

6+module Reflex.Patch

7+ ( Patch (..)

8+ , PatchDMap (..)

9+ , ComposeMaybe (..)

10+ , PatchMap (..)

11+ ) where

12+

13+import Control.Monad.Identity

14+import Data.Dependent.Map (DMap, GCompare (..))

15+import qualified Data.Dependent.Map as DMap

16+import Data.Functor.Constant

17+import Data.Map (Map)

18+import qualified Data.Map as Map

19+import Data.Semigroup (Semigroup (..), stimesIdempotentMonoid, (<>))

20+

21+-- | A 'Patch' type represents a kind of change made to a datastructure.

22+class Patch p where

23+ type PatchTarget p :: *

24+ -- | Apply the patch @p a@ to the value @a@. If no change is needed, return

25+ -- 'Nothing'.

26+ apply :: p -> PatchTarget p -> Maybe (PatchTarget p)

27+

28+-- | We can't use @Compose Maybe@ instead of 'ComposeMaybe', because that would

29+-- make the 'f' parameter have a nominal type role. We need f to be

30+-- representational so that we can use safe 'coerce'.

31+newtype ComposeMaybe f a = ComposeMaybe { getComposeMaybe :: Maybe (f a) }

32+

33+deriving instance Functor f => Functor (ComposeMaybe f)

34+

35+instance Patch (Identity a) where

36+ type PatchTarget (Identity a) = a

37+ apply (Identity a) _ = Just a

38+

39+-- | A set of changes to a 'DMap'. Only DMap types are allowed for @a@.

40+newtype PatchDMap k v = PatchDMap (DMap k (ComposeMaybe v))

41+

42+instance GCompare k => Semigroup (PatchDMap k v) where

43+ PatchDMap a <> PatchDMap b = PatchDMap $ a `mappend` b --TODO: Add a semigroup instance for DMap

44+ -- PatchDMap is idempotent, so stimes n is id for every n

45+#if MIN_VERSION_semigroups(0,17,0)

46+ stimes = stimesIdempotentMonoid

47+#else

48+ times1p n x = case compare n 0 of

49+ LT -> error "stimesIdempotentMonoid: negative multiplier"

50+ EQ -> mempty

51+ GT -> x

52+#endif

53+

54+instance GCompare k => Monoid (PatchDMap k v) where

55+ mempty = PatchDMap mempty

56+ mappend = (<>)

57+

58+instance GCompare k => Patch (PatchDMap k v) where

59+ type PatchTarget (PatchDMap k v) = DMap k v

60+ apply (PatchDMap diff) old = Just $! insertions `DMap.union` (old `DMap.difference` deletions) --TODO: return Nothing sometimes --Note: the strict application here is critical to ensuring that incremental merges don't hold onto all their prerequisite events forever; can we make this more robust?

61+ where insertions = DMap.mapMaybeWithKey (const $ getComposeMaybe) diff

62+ deletions = DMap.mapMaybeWithKey (const $ nothingToJust . getComposeMaybe) diff

63+ nothingToJust = \case

64+ Nothing -> Just $ Constant ()

65+ Just _ -> Nothing

66+

67+newtype PatchMap k v = PatchMap (Map k (Maybe v))

68+

69+instance Ord k => Patch (PatchMap k v) where

70+ type PatchTarget (PatchMap k v) = Map k v

71+ apply (PatchMap p) old = Just $! insertions `Map.union` (old `Map.difference` deletions) --TODO: return Nothing sometimes --Note: the strict application here is critical to ensuring that incremental merges don't hold onto all their prerequisite events forever; can we make this more robust?

72+ where insertions = Map.mapMaybeWithKey (const id) p

73+ deletions = Map.mapMaybeWithKey (const nothingToJust) p

74+ nothingToJust = \case

75+ Nothing -> Just ()

76+ Just _ -> Nothing

77+

78+instance Ord k => Semigroup (PatchMap k v) where

79+ PatchMap a <> PatchMap b = PatchMap $ a `mappend` b --TODO: Add a semigroup instance for Map

80+ -- PatchMap is idempotent, so stimes n is id for every n

81+#if MIN_VERSION_semigroups(0,17,0)

82+ stimes = stimesIdempotentMonoid

83+#else

84+ times1p n x = case compare n 0 of

85+ LT -> error "stimesIdempotentMonoid: negative multiplier"

86+ EQ -> mempty

87+ GT -> x

88+#endif

89+

90+instance Ord k => Monoid (PatchMap k v) where

91+ mempty = PatchMap mempty

92+ mappend = (<>)

src/Reflex/PerformEvent/Base.hs+2−1

@@ -17,8 +17,9 @@ module Reflex.PerformEvent.Base where

1717

1818import Reflex.Class

1919import Reflex.Host.Class

20−import Reflex.PostBuild.Class

20+import Reflex.Patch

2121import Reflex.PerformEvent.Class

22+import Reflex.PostBuild.Class

2223

2324import Control.Lens

2425import Control.Monad.Exception

src/Reflex/PostBuild/Class.hs+1

@@ -19,6 +19,7 @@ import Control.Monad.Trans.Control

1919import qualified Data.Dependent.Map as DMap

2020import Reflex.Class

2121import Reflex.Host.Class

22+import Reflex.Patch

2223import Reflex.PerformEvent.Class

2324

2425class (Reflex t, Monad m) => PostBuild t m | m -> t where

src/Reflex/Pure.hs+1

@@ -31,6 +31,7 @@ import Data.MemoTrie

3131import Data.Monoid

3232import Data.Type.Coercion

3333import Reflex.Class

34+import Reflex.Patch

3435

3536data Pure t

3637

src/Reflex/Spider/Internal.hs+27−26

@@ -71,6 +71,7 @@ import Data.Tree (Forest, Tree (..), drawForest)

7171import Data.WeakBag (WeakBag, WeakBagTicket)

7272import qualified Data.WeakBag as WeakBag

7373import qualified Reflex.Class as R

74+import Reflex.Patch

7475import qualified Reflex.Host.Class as R

7576

7677-- Note: must come last to silence warnings due to AMP on GHC < 7.10

@@ -296,7 +297,7 @@ eventCoincidence !c = Event $ wrap eventSubscribedCoincidence $ getCoincidenceSu

296297eventHold :: HasSpiderTimeline x => Hold x p -> Event x p

297298eventHold !h = Event $ subscribeHoldEvent h

298299

299−eventDyn :: (HasSpiderTimeline x, R.Patch p) => Dyn x p -> Event x p

300+eventDyn :: (HasSpiderTimeline x, Patch p) => Dyn x p -> Event x p

300301eventDyn !j = Event $ \sub -> getDynHold j >>= \h -> subscribeHoldEvent h sub

301302

302303{-# INLINE subscribeCoincidenceInner #-}

@@ -329,7 +330,7 @@ data Subscriber x a = Subscriber

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

330331-- the weak pointer to it in some cases.

331332

332−newSubscriberHold :: (HasSpiderTimeline x, R.Patch p) => Hold x p -> IO (Subscriber x p)

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

333334newSubscriberHold h = return $ Subscriber

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

335336 , subscriberInvalidateHeight = \_ -> return ()

@@ -564,7 +565,7 @@ unsubscribe (EventSubscription u _) = u

564565

565566newtype Behavior x a = Behavior { readBehaviorTracked :: BehaviorM x a }

566567

567−behaviorHold :: Hold x p -> Behavior x (R.PatchTarget p)

568+behaviorHold :: Hold x p -> Behavior x (PatchTarget p)

568569behaviorHold !h = Behavior $ readHoldTracked h

569570

570571behaviorHoldIdentity :: Hold x (Identity a) -> Behavior x a

@@ -600,11 +601,11 @@ behaviorPull !p = Behavior $ do

600601 askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (BehaviorSubscribedPull subscribed) :))

601602 return a

602603

603−behaviorDyn :: R.Patch p => Dyn x p -> Behavior x (R.PatchTarget p)

604+behaviorDyn :: Patch p => Dyn x p -> Behavior x (PatchTarget p)

604605behaviorDyn !d = Behavior $ readHoldTracked =<< getDynHold d

605606

606607{-# INLINE readHoldTracked #-}

607−readHoldTracked :: Hold x p -> BehaviorM x (R.PatchTarget p)

608+readHoldTracked :: Hold x p -> BehaviorM x (PatchTarget p)

608609readHoldTracked h = do

609610 result <- liftIO $ readIORef $ holdValue h

610611 askInvalidator >>= mapM_ (\wi -> liftIO $ modifyIORef' (holdInvalidators h) (wi:))

@@ -623,7 +624,7 @@ readBehaviorUntracked b = do

623624--------------------------------------------------------------------------------

624625

625626data Dynamic x p = Dynamic

626− { dynamicCurrent :: !(Behavior x (R.PatchTarget p))

627+ { dynamicCurrent :: !(Behavior x (PatchTarget p))

627628 , dynamicUpdated :: !(Event x p)

628629 }

629630

@@ -636,13 +637,13 @@ dynamicHold !h = Dynamic

636637dynamicHoldIdentity :: HasSpiderTimeline x => Hold x (Identity a) -> Dynamic x (Identity a)

637638dynamicHoldIdentity = dynamicHold

638639

639−dynamicConst :: R.PatchTarget p -> Dynamic x p

640+dynamicConst :: PatchTarget p -> Dynamic x p

640641dynamicConst !a = Dynamic

641642 { dynamicCurrent = behaviorConst a

642643 , dynamicUpdated = eventNever

643644 }

644645

645−dynamicDyn :: (HasSpiderTimeline x, R.Patch p) => Dyn x p -> Dynamic x p

646+dynamicDyn :: (HasSpiderTimeline x, Patch p) => Dyn x p -> Dynamic x p

646647dynamicDyn !d = Dynamic

647648 { dynamicCurrent = behaviorDyn d

648649 , dynamicUpdated = eventDyn d

@@ -660,7 +661,7 @@ dynamicDynIdentity = dynamicDyn

660661

661662--type role Hold representational

662663data Hold x p

663− = Hold { holdValue :: !(IORef (R.PatchTarget p))

664+ = Hold { holdValue :: !(IORef (PatchTarget p))

664665 , holdInvalidators :: !(IORef [Weak (Invalidator x)])

665666 , holdEvent :: Event x p -- This must be lazy, or holds cannot be defined before their input Events

666667 , holdParent :: !(IORef (Maybe (EventSubscription x))) -- Keeps its parent alive (will be undefined until the hold is initialized) --TODO: Probably shouldn't be an IORef

@@ -764,9 +765,9 @@ instance HasSpiderTimeline x => Defer (SomeResetCoincidence x) (EventM x) where

764765 getDeferralQueue = asksEventEnv eventEnvResetCoincidences

765766

766767-- Note: hold cannot examine its event until after the phase is over

767−{- SPECIALIZE hold :: (HasSpiderTimeline x, R.Patch p) => R.PatchTarget p -> Event x p -> EventM x (Hold x p) #-}

768+{- SPECIALIZE hold :: (HasSpiderTimeline x, Patch p) => PatchTarget p -> Event x p -> EventM x (Hold x p) #-}

768769{-# INLINE [1] hold #-}

769−hold :: (R.Patch p, Defer (SomeHoldInit x) m) => R.PatchTarget p -> Event x p -> m (Hold x p)

770+hold :: (Patch p, Defer (SomeHoldInit x) m) => PatchTarget p -> Event x p -> m (Hold x p)

770771hold v0 e = do

771772 valRef <- liftIO $ newIORef v0

772773 invsRef <- liftIO $ newIORef []

@@ -787,7 +788,7 @@ hold v0 e = do

787788 return h

788789

789790{-# INLINE getHoldEventSubscription #-}

790−getHoldEventSubscription :: forall m p x. (Defer (SomeAssignment x) m, Defer (SomeHoldInit x) m, Defer SomeClear m, R.Patch p, HasCurrentHeight x m, Defer (SomeMergeInit x) m, Defer (SomeResetCoincidence x) m, HasSpiderTimeline x, m ~ EventM x) => Hold x p -> m (EventSubscription x)

791+getHoldEventSubscription :: forall m p x. (Defer (SomeAssignment x) m, Defer (SomeHoldInit x) m, Defer SomeClear m, Patch p, HasCurrentHeight x m, Defer (SomeMergeInit x) m, Defer (SomeResetCoincidence x) m, HasSpiderTimeline x, m ~ EventM x) => Hold x p -> m (EventSubscription x)

791792getHoldEventSubscription h = do

792793 ep <- liftIO $ readIORef $ holdParent h

793794 case ep of

@@ -801,7 +802,7 @@ getHoldEventSubscription h = do

801802 Nothing -> return ()

802803 Just o -> do

803804 old <- liftIO $ readIORef $ holdValue h

804− case R.apply o old of

805+ case apply o old of

805806 Nothing -> return ()

806807 Just new -> do

807808 -- Need to evaluate these so that we don't retain the Hold itself

@@ -872,7 +873,7 @@ data Root x (k :: * -> *)

872873 , rootInit :: !(forall a. k a -> RootTrigger x a -> IO (IO ()))

873874 }

874875

875−data SomeHoldInit x = forall p. R.Patch p => SomeHoldInit !(Hold x p)

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

876877

877878data SomeMergeUpdate x = SomeMergeUpdate

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

@@ -1015,7 +1016,7 @@ instance HasSpiderTimeline x => Align (Event x) where

10151016 nil = eventNever

10161017 align ea eb = R.fmapMaybe R.dmapToThese $ merge $ dynamicConst $ DMap.fromList [R.LeftTag :=> ea, R.RightTag :=> eb]

10171018

1018−newtype Dyn x p = Dyn { unDyn :: IORef (Either (BehaviorM x (R.PatchTarget p), Event x p) (Hold x p)) }

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

10191020

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

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

@@ -1036,7 +1037,7 @@ zipDynWith f da db =

10361037 return $ Just $ Identity $ f a b

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

10381039

1039−unsafeDyn :: BehaviorM x (R.PatchTarget p) -> Event x p -> Dyn x p

1040+unsafeDyn :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p

10401041unsafeDyn readV0 v' = Dyn $ unsafeNewIORef x $ Left x

10411042 where x = (readV0, v')

10421043

@@ -1209,13 +1210,13 @@ listsToForest l = fmap (\(a, l') -> Node a $ listsToForest $ toList l') $ groupB

12091210#endif

12101211

12111212{-# INLINE propagateSubscriberHold #-}

1212−propagateSubscriberHold :: forall x p. (HasSpiderTimeline x, R.Patch p) => Hold x p -> p -> EventM x ()

1213+propagateSubscriberHold :: forall x p. (HasSpiderTimeline x, Patch p) => Hold x p -> p -> EventM x ()

12131214propagateSubscriberHold h a = do

12141215 {-# SCC "trace" #-} traceMWhen (Proxy :: Proxy x) debugPropagate $ liftIO $ do

12151216 invalidators <- liftIO $ readIORef $ holdInvalidators h

12161217 return $ "SubscriberHold" <> showNodeId h <> ": " ++ show (length invalidators)

12171218 v <- {-# SCC "read" #-} liftIO $ readIORef $ holdValue h

1218− case {-# SCC "apply" #-} R.apply a v of

1219+ case {-# SCC "apply" #-} apply a v of

12191220 Nothing -> return ()

12201221 Just v' -> do

12211222 {-# SCC "trace2" #-} withIncreasedDepth $ tracePropagate (Proxy :: Proxy x) $ "propagateSubscriberHold: assigning Hold" <> showNodeId h

@@ -1248,7 +1249,7 @@ askBehaviorHoldInits = do

12481249 return his

12491250

12501251{-# INLINE getDynHold #-}

1251−getDynHold :: (Defer (SomeHoldInit x) m, R.Patch p) => Dyn x p -> m (Hold x p)

1252+getDynHold :: (Defer (SomeHoldInit x) m, Patch p) => Dyn x p -> m (Hold x p)

12521253getDynHold d = do

12531254 mh <- liftIO $ readIORef $ unDyn d

12541255 case mh of

@@ -1488,11 +1489,11 @@ subscribeCoincidenceSubscribed :: CoincidenceSubscribed x a -> Subscriber x a ->

14881489subscribeCoincidenceSubscribed subscribed sub = WeakBag.insert sub (coincidenceSubscribedSubscribers subscribed) (coincidenceSubscribedWeakSelf subscribed) cleanupCoincidenceSubscribed

14891490

14901491{-# INLINE merge #-}

1491−merge :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (R.PatchDMap k (Event x)) -> Event x (DMap k Identity)

1492+merge :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMap k (Event x)) -> Event x (DMap k Identity)

14921493merge d = cacheEvent (mergeCheap d)

14931494

14941495{-# INLINE [1] mergeCheap #-}

1495−mergeCheap :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (R.PatchDMap k (Event x)) -> Event x (DMap k Identity)

1496+mergeCheap :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMap k (Event x)) -> Event x (DMap k Identity)

14961497mergeCheap d = Event $ \sub -> do

14971498 initialParents <- readBehaviorUntracked $ dynamicCurrent d

14981499 accumRef <- liftIO $ newIORef $ error "merge: accumRef not yet initialized"

@@ -1580,9 +1581,9 @@ mergeCheap d = Event $ \sub -> do

15801581 liftIO $ writeIORef heightBagRef $! myHeightBag

15811582 changeSubdRef <- liftIO $ newIORef $ error "getMergeSubscribed: changeSubdRef not yet initialized"

15821583 liftIO $ writeIORef parentsRef $! DMap.fromDistinctAscList $ map (\(_, _, x) -> x) subscribers

1583− let updateMe (R.PatchDMap p) = do

1584+ let updateMe (PatchDMap p) = do

15841585 oldParents <- liftIO $ readIORef parentsRef

1585− let f (subscriptionsToKill, ps) (k :=> R.ComposeMaybe me) = do

1586+ let f (subscriptionsToKill, ps) (k :=> ComposeMaybe me) = do

15861587 (mOldSubd, newPs) <- case me of

15871588 Nothing -> return $ DMap.updateLookupWithKey (\_ _ -> Nothing) k ps

15881589 Just e -> do

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

19271928 {-# INLINABLE unsafeBuildIncremental #-}

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

19291930 {-# INLINABLE mergeIncremental #-}

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

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

19311932 {-# INLINABLE currentIncremental #-}

19321933 currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental

19331934 {-# INLINABLE updatedIncremental #-}

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

19351936 {-# INLINABLE incrementalToDynamic #-}

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

19371938 c <- readBehaviorUntracked $ dynamicCurrent i

1938− return $ Identity <$> R.apply p c --TODO: Avoid the redundant 'apply'

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

19391940 eventCoercion Coercion = Coercion

19401941 behaviorCoercion Coercion = Coercion

19411942 dynamicCoercion = unsafeCoerce --TODO: How can we avoid this unsafeCoerce? This is safe only because we know how Identity works as a Patch instance

@@ -1958,7 +1959,7 @@ holdSpiderEventM v0 e = fmap (SpiderBehavior . behaviorHoldIdentity) $ hold v0 $

19581959holdDynSpiderEventM :: HasSpiderTimeline x => a -> R.Event (SpiderTimeline x) a -> EventM x (R.Dynamic (SpiderTimeline x) a)

19591960holdDynSpiderEventM v0 e = fmap (SpiderDynamic . dynamicHoldIdentity) $ hold v0 $ coerce $ unSpiderEvent e

19601961

1961−holdIncrementalSpiderEventM :: (HasSpiderTimeline x, R.Patch p) => R.PatchTarget p -> R.Event (SpiderTimeline x) p -> EventM x (R.Incremental (SpiderTimeline x) p)

1962+holdIncrementalSpiderEventM :: (HasSpiderTimeline x, Patch p) => PatchTarget p -> R.Event (SpiderTimeline x) p -> EventM x (R.Incremental (SpiderTimeline x) p)

19621963holdIncrementalSpiderEventM v0 e = fmap (SpiderIncremental . dynamicHold) $ hold v0 $ unSpiderEvent e

19631964

19641965instance HasSpiderTimeline x => R.MonadHold (SpiderTimeline x) (SpiderHost x) where