0f4f058 · reflex · git.iko.soy

git.iko.soy/reflex

on develop help sign in

Merge branch 'develop' into extra-query-instances

0f4f058John Ericson7 years ago

ChangeLog.md+6

compare with develop

unifiedsplit

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

1# Revision history for reflex

3+## Unreleased

5+* Data.WeakBag.traverse and Data.FastWeakBag.traverse have been

6+ renamed to Data.WeakBag.traverse_ and Data.FastWeakBag.traverse_

7+ respectively.

3## 0.6.2.4

9## 0.6.2.4

5* Update to monoidal-containers 0.6

11* Update to monoidal-containers 0.6

default.nix+8−2

@@ -7,13 +7,18 @@

7, transformers-compat, unbounded-delays, prim-uniq

8, data-default, filepath, directory, filemanip, ghcjs-base

9, monoidal-containers, witherable, profunctors

10−, semialign ? null, splitThese ? (semialign != null)

10+, splitThese ? (semialign != null), semialign ? null, these-lens ? null

11, useTemplateHaskell ? true

12}:

13mkDerivation {

14 pname = "reflex";

15 version = "0.6.2.4";

16− src = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [ ".git" "dist" ])) ./.;

16+ src = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [

17+ "default.nix"

18+ "release.nix"

19+ ".git"

20+ "dist"

21+ ])) ./.;

17 libraryHaskellDepends = [

22 libraryHaskellDepends = [

18 base bifunctors containers dependent-map dependent-sum

23 base bifunctors containers dependent-map dependent-sum

19 exception-transformers lens

24 exception-transformers lens

@@ -30,6 +35,7 @@ mkDerivation {

30 haskell-src-exts haskell-src-meta

35 haskell-src-exts haskell-src-meta

31 ]) ++ (if splitThese then [

36 ]) ++ (if splitThese then [

32 semialign

37 semialign

38+ these-lens

33 ] else []);

39 ] else []);

34 testHaskellDepends = if ghc.isGhcjs or false then [] else [

40 testHaskellDepends = if ghc.isGhcjs or false then [] else [

35 hlint filepath directory filemanip

41 hlint filepath directory filemanip

dep/reflex-platform/default.nixnew file+7

@@ -0,0 +1,7 @@

1+# DO NOT HAND-EDIT THIS FILE

2+import ((import <nixpkgs> {}).fetchFromGitHub (

3+ let json = builtins.fromJSON (builtins.readFile ./github.json);

4+ in { inherit (json) owner repo rev sha256;

5+ private = json.private or false;

6+ }

7+))

dep/reflex-platform/github.jsonnew file+7

@@ -0,0 +1,7 @@

1+{

2+ "owner": "reflex-frp",

3+ "repo": "reflex-platform",

4+ "branch": "jailbreakTheselens",

5+ "rev": "4284ed527c96c373538dc7e31776d9a50ca6aa91",

6+ "sha256": "1m1nkxq7ng9wnqbd77xn8d81f2iz8g61y5m0r3gp0gi0q59jm8ay"

7+}

hydra.jsondeleted−29

@@ -1,29 +0,0 @@

1−{

2− "enabled": 1,

3− "hidden": true,

4− "description": "Jobsets",

5− "nixexprinput": "src",

6− "nixexprpath": "jobsets.nix",

7− "checkinterval": 300,

8− "schedulingshares": 100,

9− "enableemail": false,

10− "emailoverride": "",

11− "keepnr": 10,

12− "inputs": {

13− "src": {

14− "type": "git",

15− "value": "https://github.com/reflex-frp/reflex.git develop",

16− "emailresponsible": false

17− },

18− "nixpkgs": {

19− "type": "git",

20− "value": "https://github.com/NixOS/nixpkgs-channels nixos-unstable",

21− "emailresponsible": false

22− },

23− "prs": {

24− "type": "githubpulls",

25− "value": "reflex-frp reflex",

26− "emailresponsible": false

27− }

28− }

29−}

jobsets.nixdeleted−70

@@ -1,70 +0,0 @@

1−{ prs }:

2−

3−let

4− pkgs = (import ./reflex-platform.nix {}).nixpkgs;

5− mkFetchGithub = value: {

6− inherit value;

7− type = "git";

8− emailresponsible = false;

9− };

10−in

11−with pkgs.lib;

12−let

13− defaults = jobs: {

14− inherit (jobs) description;

15− enabled = 1;

16− hidden = false;

17− keepnr = 10;

18− schedulingshares = 100;

19− checkinterval = 120;

20− enableemail = false;

21− emailoverride = "";

22− nixexprinput = "reflex";

23− nixexprpath = "release.nix";

24− inputs = jobs.inputs // {

25− nixpkgs = {

26− type = "git";

27− value = "https://github.com/NixOS/nixpkgs-channels nixos-unstable";

28− emailresponsible = false;

29− };

30− config = {

31− type = "nix";

32− value = "{ android_sdk.accept_license = true; }";

33− emailresponsible = false;

34− };

35− };

36− };

37− branchJobset = branch: defaults {

38− description = "reflex-${branch}";

39− inputs = {

40− reflex = {

41− value = "https://github.com/reflex-frp/reflex ${branch}";

42− type = "git";

43− emailresponsible = false;

44− };

45− };

46− };

47− makePr = num: info: {

48− name = "reflex-pr-${num}";

49− value = defaults {

50− description = "#${num}: ${info.title}";

51− inputs = {

52− reflex = {

53− #NOTE: This should really use "pull/${num}/merge"; however, GitHub's

54− #status checks only operate on PR heads. This creates a race

55− #condition, which can currently only be solved by requiring PRs to be

56− #up to date before they're merged. See

57− #https://github.com/isaacs/github/issues/1002

58− value = "https://github.com/reflex-frp/reflex pull/${num}/head";

59− type = "git";

60− emailresponsible = false;

61− };

62− };

63− };

64− };

65− processedPrs = mapAttrs' makePr (builtins.fromJSON (builtins.readFile prs));

66− jobsetsAttrs = processedPrs //

67− genAttrs ["develop"] branchJobset;

68−in {

69− jobsets = pkgs.writeText "spec.json" (builtins.toJSON jobsetsAttrs);

70−}

reflex-platform.nixdeleted−8

@@ -1,8 +0,0 @@

1−let

2− reflex-platform-src = (import <nixpkgs> {}).fetchFromGitHub {

3− owner = "reflex-frp";

4− repo = "reflex-platform";

5− rev = "384cd850f3adf1d404bced2424b5f6efb0f415f2";

6− sha256 = "1ws77prqx8khmp8j6br1ij4k2v4dlgv170r9fmg0p1jivfbn8y9d";

7− };

8−in import reflex-platform-src

reflex.cabal+1−1

@@ -78,7 +78,7 @@ library

79 if flag(split-these)

80 build-depends: these >= 1 && <1.1,

81− semialign >=1 && <1.1,

81+ semialign >=1 && <1.2,

82 monoidal-containers >= 0.6 && < 0.7

83 else

84 build-depends: these >= 0.4 && <0.9,

release.nix+36−7

@@ -1,9 +1,38 @@

1−{ rp ? import ./reflex-platform.nix {}

1+{ reflex-platform-fun ? import ./dep/reflex-platform

2}:

3let

4let

5+ native-reflex-platform = reflex-platform-fun {};

4− inherit (rp.nixpkgs) lib;

6+ inherit (native-reflex-platform.nixpkgs) lib;

5− compilers = ["ghc8_4" "ghc8_0" "ghcjs8_4" "ghcjs8_0"];

7+ systems = ["x86_64-linux" "x86_64-darwin"];

9+ perPlatform = lib.genAttrs systems (system: let

10+ reflex-platform = reflex-platform-fun { inherit system; };

11+ compilers = [

12+ "ghc"

13+ "ghcjs"

14+ ] ++ lib.optionals (reflex-platform.androidSupport) [

15+ "ghcAndroidAarch64"

16+ "ghcAndroidAarch32"

17+ ] ++ lib.optionals (reflex-platform.iosSupport) [

18+ "ghcIosAarch64"

19+ ];

6−in lib.attrValues (lib.genAttrs compilers (ghc: {

20+ hsPkgs = lib.genAttrs compilers (ghc: let

21+ ghc' = reflex-platform.${ghc}.override {

22+ overrides = self: super: {

23+ reflex-dontUseTemplateHaskell = self.callPackage ./. { useTemplateHaskell = false; };

7− reflex-useTemplateHaskell = rp.${ghc}.callPackage ./. { useTemplateHaskell = true; splitThese = false; };

24+ reflex = self.callPackage ./. { useTemplateHaskell = true; };

8− reflex = rp.${ghc}.callPackage ./. { useTemplateHaskell = false; splitThese = false; };

25+ };

9−}))

26+ };

27+ in {

28+ inherit (ghc') reflex reflex-dontUseTemplateHaskell;

29+ });

30+ in hsPkgs // {

31+ cache = reflex-platform.pinBuildInputs "reflex-${system}"

32+ (lib.concatLists (map builtins.attrValues (builtins.attrValues hsPkgs)));

33+ });

34+

35+ metaCache = native-reflex-platform.pinBuildInputs "reflex-everywhere"

36+ (map (a: a.cache) (builtins.attrValues perPlatform));

37+

38+in perPlatform // { inherit metaCache; }

src/Data/FastWeakBag.hs+9−4

@@ -18,6 +18,7 @@ module Data.FastWeakBag

18 , isEmpty

19 , insert

20 , traverse

21+ , traverse_

21 , remove

22 , remove

22 -- * Internal functions

23 -- * Internal functions

23 -- These will not always be available.

24 -- These will not always be available.

@@ -116,14 +117,14 @@ foreign import javascript unsafe "(function(){ for(var i = 0; i < $1.tickets.len

116isEmpty bag = {-# SCC "isEmpty" #-} IntMap.null <$> readIORef (_weakBag_children bag)

117isEmpty bag = {-# SCC "isEmpty" #-} IntMap.null <$> readIORef (_weakBag_children bag)

117#endif

118#endif

118

119

119−{-# INLINE traverse #-}

120+{-# INLINE traverse_ #-}

120-- | Visit every node in the given list. If new nodes are appended during the

121-- | Visit every node in the given list. If new nodes are appended during the

121-- traversal, they will not be visited. Every live node that was in the list

122-- traversal, they will not be visited. Every live node that was in the list

122-- when the traversal began will be visited exactly once; however, no guarantee

123-- when the traversal began will be visited exactly once; however, no guarantee

123-- is made about the order of the traversal.

124-- is made about the order of the traversal.

124−traverse :: forall a m. MonadIO m => FastWeakBag a -> (a -> m ()) -> m ()

125+traverse_ :: forall a m. MonadIO m => FastWeakBag a -> (a -> m ()) -> m ()

125#ifdef GHCJS_FAST_WEAK

126#ifdef GHCJS_FAST_WEAK

126−traverse wb f = do

127+traverse_ wb f = do

127 let go cursor = when (not $ js_isNull cursor) $ do

128 let go cursor = when (not $ js_isNull cursor) $ do

128 val <- liftIO $ js_getTicketValue cursor

129 val <- liftIO $ js_getTicketValue cursor

129 f $ unsafeFromRawJSVal val

130 f $ unsafeFromRawJSVal val

@@ -134,13 +135,17 @@ foreign import javascript unsafe "$r = $1.val;" js_getTicketValue :: JSVal -> IO

134--TODO: Fix the race condition where if a cursor is deleted (presumably using 'remove', below) while we're holding it, it can't find its way back to the correct bag

135--TODO: Fix the race condition where if a cursor is deleted (presumably using 'remove', below) while we're holding it, it can't find its way back to the correct bag

135foreign import javascript unsafe "(function(){ for(var i = $1.pos - 1; i >= 0; i--) { if($1.bag.tickets[i] !== null) { return $1.bag.tickets[i]; } }; return null; })()" js_getNext :: FastWeakBagTicket a -> IO JSVal --TODO: Clean up as we go along so this isn't O(n) every time -- Result can be null or a FastWeakBagTicket a

136foreign import javascript unsafe "(function(){ for(var i = $1.pos - 1; i >= 0; i--) { if($1.bag.tickets[i] !== null) { return $1.bag.tickets[i]; } }; return null; })()" js_getNext :: FastWeakBagTicket a -> IO JSVal --TODO: Clean up as we go along so this isn't O(n) every time -- Result can be null or a FastWeakBagTicket a

136#else

137#else

137−traverse (FastWeakBag _ children) f = {-# SCC "traverse" #-} do

138+traverse_ (FastWeakBag _ children) f = {-# SCC "traverse_" #-} do

138 cs <- liftIO $ readIORef children

139 cs <- liftIO $ readIORef children

139 forM_ cs $ \c -> do

140 forM_ cs $ \c -> do

140 ma <- liftIO $ deRefWeak c

141 ma <- liftIO $ deRefWeak c

141 mapM_ f ma

142 mapM_ f ma

142#endif

143#endif

143

144

145+{-# DEPRECATED traverse "Use 'traverse_' instead" #-}

146+traverse :: forall a m. MonadIO m => FastWeakBag a -> (a -> m ()) -> m ()

147+traverse = traverse_

148+

144-- | Remove an item from the 'FastWeakBag'; does nothing if invoked multiple times

149-- | Remove an item from the 'FastWeakBag'; does nothing if invoked multiple times

145-- on the same 'FastWeakBagTicket'.

150-- on the same 'FastWeakBagTicket'.

146{-# INLINE remove #-}

151{-# INLINE remove #-}

src/Data/WeakBag.hs+8−3

@@ -15,6 +15,7 @@ module Data.WeakBag

15 , singleton

16 , insert

17 , traverse

18+ , traverse_

18 , remove

19 , remove

19 -- * Internal functions

20 -- * Internal functions

20 -- These will not always be available.

21 -- These will not always be available.

@@ -99,18 +100,22 @@ singleton a wbRef finalizer = {-# SCC "singleton" #-} do

99 ticket <- insert a bag wbRef finalizer

100 ticket <- insert a bag wbRef finalizer

100 return (bag, ticket)

101 return (bag, ticket)

101

102

102−{-# INLINE traverse #-}

103+{-# INLINE traverse_ #-}

103-- | Visit every node in the given list. If new nodes are appended during the

104-- | Visit every node in the given list. If new nodes are appended during the

104-- traversal, they will not be visited. Every live node that was in the list

105-- traversal, they will not be visited. Every live node that was in the list

105-- when the traversal began will be visited exactly once; however, no guarantee

106-- when the traversal began will be visited exactly once; however, no guarantee

106-- is made about the order of the traversal.

107-- is made about the order of the traversal.

107−traverse :: MonadIO m => WeakBag a -> (a -> m ()) -> m ()

108+traverse_ :: MonadIO m => WeakBag a -> (a -> m ()) -> m ()

108−traverse (WeakBag _ children) f = {-# SCC "traverse" #-} do

109+traverse_ (WeakBag _ children) f = {-# SCC "traverse" #-} do

109 cs <- liftIO $ readIORef children

110 cs <- liftIO $ readIORef children

110 forM_ cs $ \c -> do

111 forM_ cs $ \c -> do

111 ma <- liftIO $ deRefWeak c

112 ma <- liftIO $ deRefWeak c

112 mapM_ f ma

113 mapM_ f ma

113

114

115+{-# DEPRECATED traverse "Use 'traverse_' instead" #-}

116+traverse :: MonadIO m => WeakBag a -> (a -> m ()) -> m ()

117+traverse = traverse_

118+

114-- | Remove an item from the 'WeakBag'; does nothing if invoked multiple times

119-- | Remove an item from the 'WeakBag'; does nothing if invoked multiple times

115-- on the same 'WeakBagTicket'.

120-- on the same 'WeakBagTicket'.

116{-# INLINE remove #-}

121{-# INLINE remove #-}

src/Reflex/Class.hs+8−2

@@ -173,12 +173,15 @@ module Reflex.Class

173 , slowHeadE

174 ) where

175

176−#if defined(MIN_VERSION_semialign)

176+#ifdef MIN_VERSION_semialign

177import Prelude hiding (zip, zipWith)

178

179#if MIN_VERSION_these(0,8,0)

180import Data.These.Combinators (justThese)

181#endif

182+#if MIN_VERSION_semialign(1,1,0)

183+import Data.Zip (Zip (..))

184+#endif

182#endif

185#endif

183

186

184import Control.Applicative

187import Control.Applicative

@@ -1077,7 +1080,10 @@ instance Reflex t => Semialign (Event t) where

1077#endif

1080#endif

1078 align = alignEventWithMaybe Just

1081 align = alignEventWithMaybe Just

1079

1082

1080−#if defined(MIN_VERSION_semialign)

1083+#ifdef MIN_VERSION_semialign

1084+#if MIN_VERSION_semialign(1,1,0)

1085+instance Reflex t => Zip (Event t) where

1086+#endif

1081 zip x y = mapMaybe justThese $ align x y

1087 zip x y = mapMaybe justThese $ align x y

1082#endif

1088#endif

1083

1089

src/Reflex/Collection.hs+4−1

@@ -27,8 +27,11 @@ module Reflex.Collection

27 , simpleList

28 ) where

30−#if defined(MIN_VERSION_semialign)

30+#ifdef MIN_VERSION_semialign

31import Prelude hiding (zip, zipWith)

32+#if MIN_VERSION_semialign(1,1,0)

33+import Data.Zip (Zip (..))

34+#endif

32#endif

35#endif

34import Control.Monad.Identity

37import Control.Monad.Identity

src/Reflex/Spider/Internal.hs+24−18

@@ -72,10 +72,13 @@ import System.IO.Unsafe

72import System.Mem.Weak

73import Unsafe.Coerce

75−#if defined(MIN_VERSION_semialign)

75+#ifdef MIN_VERSION_semialign

76#if MIN_VERSION_these(0,8,0)

77import Data.These.Combinators (justThese)

78#endif

79+#if MIN_VERSION_semialign(1,1,0)

80+import Data.Zip (Zip (..))

81+#endif

79#endif

82#endif

81#ifdef DEBUG_CYCLES

84#ifdef DEBUG_CYCLES

@@ -329,9 +332,9 @@ cacheEvent e =

329 scheduleClear occRef

332 scheduleClear occRef

330 propagateFast a subscribers

333 propagateFast a subscribers

331 , subscriberInvalidateHeight = \old -> do

334 , subscriberInvalidateHeight = \old -> do

332− FastWeakBag.traverse subscribers $ invalidateSubscriberHeight old

335+ FastWeakBag.traverse_ subscribers $ invalidateSubscriberHeight old

333 , subscriberRecalculateHeight = \new -> do

336 , subscriberRecalculateHeight = \new -> do

334− FastWeakBag.traverse subscribers $ recalculateSubscriberHeight new

337+ FastWeakBag.traverse_ subscribers $ recalculateSubscriberHeight new

335 }

338 }

336 when (isJust occ) $ do

339 when (isJust occ) $ do

337 liftIO $ writeIORef occRef occ -- Set the initial value of occRef; we don't need to do this if occ is Nothing

340 liftIO $ writeIORef occRef occ -- Set the initial value of occRef; we don't need to do this if occ is Nothing

@@ -447,12 +450,12 @@ newSubscriberFan subscribed = return $ Subscriber

447 , subscriberInvalidateHeight = \old -> do

450 , subscriberInvalidateHeight = \old -> do

448 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed

451 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed

449 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

452 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

450− forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse (_fanSubscribedChildren_list v) $ invalidateSubscriberHeight old

453+ forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse_ (_fanSubscribedChildren_list v) $ invalidateSubscriberHeight old

451 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"

454 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"

452 , subscriberRecalculateHeight = \new -> do

455 , subscriberRecalculateHeight = \new -> do

453 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed

456 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed

454 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

457 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

455− forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse (_fanSubscribedChildren_list v) $ recalculateSubscriberHeight new

458+ forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse_ (_fanSubscribedChildren_list v) $ recalculateSubscriberHeight new

456 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"

459 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"

457 }

460 }

458

461

@@ -468,7 +471,7 @@ newSubscriberSwitch subscribed = return $ Subscriber

468 oldHeight <- readIORef $ switchSubscribedHeight subscribed

471 oldHeight <- readIORef $ switchSubscribedHeight subscribed

469 when (oldHeight /= invalidHeight) $ do

472 when (oldHeight /= invalidHeight) $ do

470 writeIORef (switchSubscribedHeight subscribed) $! invalidHeight

473 writeIORef (switchSubscribedHeight subscribed) $! invalidHeight

471− WeakBag.traverse (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight

474+ WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight

472 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed <> " done"

475 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed <> " done"

473 , subscriberRecalculateHeight = \new -> do

476 , subscriberRecalculateHeight = \new -> do

474 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed

477 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed

@@ -491,8 +494,8 @@ newSubscriberCoincidenceOuter subscribed = return $ Subscriber

491 Nothing -> do

494 Nothing -> do

492 when (innerHeight > outerHeight) $ liftIO $ do -- If the event fires, it will fire at a later height

495 when (innerHeight > outerHeight) $ liftIO $ do -- If the event fires, it will fire at a later height

493 writeIORef (coincidenceSubscribedHeight subscribed) $! innerHeight

496 writeIORef (coincidenceSubscribedHeight subscribed) $! innerHeight

494− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight outerHeight

497+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight outerHeight

495− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight innerHeight

498+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight innerHeight

496 Just o -> do -- Since it's already firing, no need to adjust height

499 Just o -> do -- Since it's already firing, no need to adjust height

497 liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) occ

500 liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) occ

498 scheduleClear $ coincidenceSubscribedOccurrence subscribed

501 scheduleClear $ coincidenceSubscribedOccurrence subscribed

@@ -539,14 +542,14 @@ propagate :: a -> WeakBag (Subscriber x a) -> EventM x ()

539propagate a subscribers = withIncreasedDepth $ do

542propagate a subscribers = withIncreasedDepth $ do

540 -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them

543 -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them

541 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work

544 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work

542− WeakBag.traverse subscribers $ \s -> subscriberPropagate s a

545+ WeakBag.traverse_ subscribers $ \s -> subscriberPropagate s a

543

546

544-- | Propagate everything at the current height

547-- | Propagate everything at the current height

545propagateFast :: a -> FastWeakBag (Subscriber x a) -> EventM x ()

548propagateFast :: a -> FastWeakBag (Subscriber x a) -> EventM x ()

546propagateFast a subscribers = withIncreasedDepth $ do

549propagateFast a subscribers = withIncreasedDepth $ do

547 -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them

550 -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them

548 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work

551 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work

549− FastWeakBag.traverse subscribers $ \s -> subscriberPropagate s a

552+ FastWeakBag.traverse_ subscribers $ \s -> subscriberPropagate s a

550

553

551--------------------------------------------------------------------------------

554--------------------------------------------------------------------------------

552-- EventSubscribed

555-- EventSubscribed

@@ -1163,7 +1166,10 @@ instance HasSpiderTimeline x => Semialign (Event x) where

1163 align ea eb = mapMaybe dmapToThese $ mergeG coerce $ dynamicConst $

1166 align ea eb = mapMaybe dmapToThese $ mergeG coerce $ dynamicConst $

1164 DMap.fromDistinctAscList [LeftTag :=> ea, RightTag :=> eb]

1167 DMap.fromDistinctAscList [LeftTag :=> ea, RightTag :=> eb]

1165

1168

1166−#if defined(MIN_VERSION_semialign)

1169+#ifdef MIN_VERSION_semialign

1170+#if MIN_VERSION_semialign(1,1,0)

1171+instance HasSpiderTimeline x => Zip (Event x) where

1172+#endif

1167 zip x y = mapMaybe justThese $ align x y

1173 zip x y = mapMaybe justThese $ align x y

1168#endif

1174#endif

1169

1175

@@ -1521,15 +1527,15 @@ fanInt p = unsafePerformIO $ do

1521 liftIO $ writeIORef (_fanInt_occRef self) m

1527 liftIO $ writeIORef (_fanInt_occRef self) m

1522 scheduleIntClear $ _fanInt_occRef self

1528 scheduleIntClear $ _fanInt_occRef self

1523 FastMutableIntMap.forIntersectionWithImmutable_ (_fanInt_subscribers self) m $ \b v -> do --TODO: Do we need to know that no subscribers are being added as we traverse?

1529 FastMutableIntMap.forIntersectionWithImmutable_ (_fanInt_subscribers self) m $ \b v -> do --TODO: Do we need to know that no subscribers are being added as we traverse?

1524− FastWeakBag.traverse b $ \s -> do

1530+ FastWeakBag.traverse_ b $ \s -> do

1525 subscriberPropagate s v

1531 subscriberPropagate s v

1526 , subscriberInvalidateHeight = \old -> do

1532 , subscriberInvalidateHeight = \old -> do

1527 FastMutableIntMap.for_ (_fanInt_subscribers self) $ \b -> do

1533 FastMutableIntMap.for_ (_fanInt_subscribers self) $ \b -> do

1528− FastWeakBag.traverse b $ \s -> do

1534+ FastWeakBag.traverse_ b $ \s -> do

1529 subscriberInvalidateHeight s old

1535 subscriberInvalidateHeight s old

1530 , subscriberRecalculateHeight = \new -> do

1536 , subscriberRecalculateHeight = \new -> do

1531 FastMutableIntMap.for_ (_fanInt_subscribers self) $ \b -> do

1537 FastMutableIntMap.for_ (_fanInt_subscribers self) $ \b -> do

1532− FastWeakBag.traverse b $ \s -> do

1538+ FastWeakBag.traverse_ b $ \s -> do

1533 subscriberRecalculateHeight s new

1539 subscriberRecalculateHeight s new

1534 }

1540 }

1535 liftIO $ do

1541 liftIO $ do

@@ -2201,7 +2207,7 @@ runFrame a = SpiderHost $ do

2201 myHeight <- readIORef $ switchSubscribedHeight subscribed

2207 myHeight <- readIORef $ switchSubscribedHeight subscribed

2202 when (parentHeight /= myHeight) $ do

2208 when (parentHeight /= myHeight) $ do

2203 writeIORef (switchSubscribedHeight subscribed) $! invalidHeight

2209 writeIORef (switchSubscribedHeight subscribed) $! invalidHeight

2204− WeakBag.traverse (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight myHeight

2210+ WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight myHeight

2205 mapM_ _someMergeUpdate_invalidateHeight mergeUpdates --TODO: In addition to when the patch is completely empty, we should also not run this if it has some Nothing values, but none of them have actually had any effect; potentially, we could even check for Just values with no effect (e.g. by comparing their IORefs and ignoring them if they are unchanged); actually, we could just check if the new height is different

2211 mapM_ _someMergeUpdate_invalidateHeight mergeUpdates --TODO: In addition to when the patch is completely empty, we should also not run this if it has some Nothing values, but none of them have actually had any effect; potentially, we could even check for Just values with no effect (e.g. by comparing their IORefs and ignoring them if they are unchanged); actually, we could just check if the new height is different

2206 forM_ coincidenceInfos $ \(SomeResetCoincidence subscription mcs) -> do

2212 forM_ coincidenceInfos $ \(SomeResetCoincidence subscription mcs) -> do

2207 unsubscribe subscription

2213 unsubscribe subscription

@@ -2242,7 +2248,7 @@ invalidateCoincidenceHeight subscribed = do

2242 oldHeight <- readIORef $ coincidenceSubscribedHeight subscribed

2248 oldHeight <- readIORef $ coincidenceSubscribedHeight subscribed

2243 when (oldHeight /= invalidHeight) $ do

2249 when (oldHeight /= invalidHeight) $ do

2244 writeIORef (coincidenceSubscribedHeight subscribed) $! invalidHeight

2250 writeIORef (coincidenceSubscribedHeight subscribed) $! invalidHeight

2245− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight

2251+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight

2246

2252

2247updateSwitchHeight :: Height -> SwitchSubscribed x a -> IO ()

2253updateSwitchHeight :: Height -> SwitchSubscribed x a -> IO ()

2248updateSwitchHeight new subscribed = do

2254updateSwitchHeight new subscribed = do

@@ -2250,7 +2256,7 @@ updateSwitchHeight new subscribed = do

2250 when (oldHeight == invalidHeight) $ do --TODO: This 'when' should probably be an assertion

2256 when (oldHeight == invalidHeight) $ do --TODO: This 'when' should probably be an assertion

2251 when (new /= invalidHeight) $ do --TODO: This 'when' should probably be an assertion

2257 when (new /= invalidHeight) $ do --TODO: This 'when' should probably be an assertion

2252 writeIORef (switchSubscribedHeight subscribed) $! new

2258 writeIORef (switchSubscribedHeight subscribed) $! new

2253− WeakBag.traverse (switchSubscribedSubscribers subscribed) $ recalculateSubscriberHeight new

2259+ WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ recalculateSubscriberHeight new

2254

2260

2255recalculateCoincidenceHeight :: CoincidenceSubscribed x a -> IO ()

2261recalculateCoincidenceHeight :: CoincidenceSubscribed x a -> IO ()

2256recalculateCoincidenceHeight subscribed = do

2262recalculateCoincidenceHeight subscribed = do

@@ -2259,7 +2265,7 @@ recalculateCoincidenceHeight subscribed = do

2259 height <- calculateCoincidenceHeight subscribed

2265 height <- calculateCoincidenceHeight subscribed

2260 when (height /= invalidHeight) $ do

2266 when (height /= invalidHeight) $ do

2261 writeIORef (coincidenceSubscribedHeight subscribed) $! height

2267 writeIORef (coincidenceSubscribedHeight subscribed) $! height

2262− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight height

2268+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight height

2263

2269

2264calculateSwitchHeight :: SwitchSubscribed x a -> IO Height

2270calculateSwitchHeight :: SwitchSubscribed x a -> IO Height

2265calculateSwitchHeight subscribed = getEventSubscribedHeight . _eventSubscription_subscribed =<< readIORef (switchSubscribedCurrentParent subscribed)

2271calculateSwitchHeight subscribed = getEventSubscribedHeight . _eventSubscription_subscribed =<< readIORef (switchSubscribedCurrentParent subscribed)